{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
module Test.Tasty.Bench
(
#ifdef MIN_VERSION_tasty
defaultMain
, Benchmark
, bench
, bgroup
, bcompare
, bcompareWithin
, env
, envWithCleanup
,
#endif
Benchmarkable(..)
, nf
, whnf
, nfIO
, whnfIO
, nfAppIO
, whnfAppIO
, measureCpuTime
#ifdef MIN_VERSION_tasty
, benchIngredients
, consoleBenchReporter
, csvReporter
, svgReporter
, RelStDev(..)
, FailIfSlower(..)
, FailIfFaster(..)
, CsvPath(..)
, BaselinePath(..)
, SvgPath(..)
, TimeMode(..)
, locateBenchmark
, mapLeafBenchmarks
#else
, Timeout(..)
, RelStDev(..)
#endif
) where
import Prelude hiding (Int, Integer)
import qualified Prelude
import Control.Applicative
import Control.Arrow (first, second)
import Control.DeepSeq (NFData, force)
import Control.Exception (bracket, evaluate)
import Control.Monad (void, unless, guard, (>=>), when)
import Data.Data (Typeable)
import Data.Foldable (foldMap, traverse_)
import Data.Int (Int64)
import Data.IORef
import Data.List (intercalate, stripPrefix, isPrefixOf, genericLength, genericDrop, foldl1')
import Data.Maybe (fromMaybe)
import Data.Monoid (All(..), Any(..))
import Data.Proxy
import Data.Traversable (forM)
import Data.Word (Word64)
import GHC.Conc
#if MIN_VERSION_base(4,5,0)
import GHC.IO.Encoding
#endif
#if MIN_VERSION_base(4,6,0)
import GHC.Stats
#endif
import System.CPUTime
import System.Exit
import System.IO
import System.IO.Unsafe
import System.Mem
import Text.Printf
#ifdef DEBUG
import Debug.Trace
#endif
#ifdef MIN_VERSION_tasty
#if !MIN_VERSION_base(4,8,0)
import Data.Monoid (Monoid(..))
#endif
#if MIN_VERSION_base(4,9,0)
import Data.Semigroup (Semigroup(..))
#endif
#if MIN_VERSION_containers(0,5,0)
import qualified Data.IntMap.Strict as IM
#else
import qualified Data.IntMap as IM
#endif
import Data.IntMap (IntMap)
import Data.Sequence (Seq, (<|))
import qualified Data.Sequence as Seq
import qualified Data.Set as S
import Test.Tasty hiding (defaultMain)
import qualified Test.Tasty
import Test.Tasty.Ingredients
import Test.Tasty.Ingredients.ConsoleReporter
import Test.Tasty.Options
import Test.Tasty.Patterns.Eval (eval, asB, withFields)
import Test.Tasty.Patterns.Types (Expr (And, Field, IntLit, NF, StringLit, Sub))
import qualified Test.Tasty.Patterns.Types as Patterns
import Test.Tasty.Providers
import Test.Tasty.Runners
#endif
#if defined(mingw32_HOST_OS)
import Data.Word (Word32)
#endif
#if MIN_VERSION_ghc_prim(0,3,1)
import GHC.Types (SPEC(..))
#else
import GHC.Exts (SpecConstrAnnotation(..))
data SPEC = SPEC | SPEC2
{-# ANN type SPEC ForceSpecConstr #-}
#endif
#ifndef MIN_VERSION_tasty
data Timeout
= Timeout
Prelude.Integer
String
| NoTimeout
deriving (Show)
#endif
newtype RelStDev = RelStDev Double
deriving (Int -> RelStDev -> ShowS
[RelStDev] -> ShowS
RelStDev -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RelStDev] -> ShowS
$cshowList :: [RelStDev] -> ShowS
show :: RelStDev -> String
$cshow :: RelStDev -> String
showsPrec :: Int -> RelStDev -> ShowS
$cshowsPrec :: Int -> RelStDev -> ShowS
Show, ReadPrec [RelStDev]
ReadPrec RelStDev
Int -> ReadS RelStDev
ReadS [RelStDev]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RelStDev]
$creadListPrec :: ReadPrec [RelStDev]
readPrec :: ReadPrec RelStDev
$creadPrec :: ReadPrec RelStDev
readList :: ReadS [RelStDev]
$creadList :: ReadS [RelStDev]
readsPrec :: Int -> ReadS RelStDev
$creadsPrec :: Int -> ReadS RelStDev
Read, Typeable)
data TimeMode = CpuTime
#ifdef MIN_VERSION_tasty
| WallTime
#endif
deriving (Typeable)
#ifdef MIN_VERSION_tasty
instance IsOption RelStDev where
defaultValue :: RelStDev
defaultValue = Double -> RelStDev
RelStDev Double
0.05
parseValue :: String -> Maybe RelStDev
parseValue = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> RelStDev
RelStDev forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Double
parsePositivePercents
optionName :: Tagged RelStDev String
optionName = forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"stdev"
optionHelp :: Tagged RelStDev String
optionHelp = forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"Target relative standard deviation of measurements in percents (5 by default). Large values correspond to fast and loose benchmarks, and small ones to long and precise. If it takes far too long, consider setting --timeout, which will interrupt benchmarks, potentially before reaching the target deviation."
newtype FailIfSlower = FailIfSlower Double
deriving (Int -> FailIfSlower -> ShowS
[FailIfSlower] -> ShowS
FailIfSlower -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FailIfSlower] -> ShowS
$cshowList :: [FailIfSlower] -> ShowS
show :: FailIfSlower -> String
$cshow :: FailIfSlower -> String
showsPrec :: Int -> FailIfSlower -> ShowS
$cshowsPrec :: Int -> FailIfSlower -> ShowS
Show, ReadPrec [FailIfSlower]
ReadPrec FailIfSlower
Int -> ReadS FailIfSlower
ReadS [FailIfSlower]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FailIfSlower]
$creadListPrec :: ReadPrec [FailIfSlower]
readPrec :: ReadPrec FailIfSlower
$creadPrec :: ReadPrec FailIfSlower
readList :: ReadS [FailIfSlower]
$creadList :: ReadS [FailIfSlower]
readsPrec :: Int -> ReadS FailIfSlower
$creadsPrec :: Int -> ReadS FailIfSlower
Read, Typeable)
instance IsOption FailIfSlower where
defaultValue :: FailIfSlower
defaultValue = Double -> FailIfSlower
FailIfSlower (Double
1.0 forall a. Fractional a => a -> a -> a
/ Double
0.0)
parseValue :: String -> Maybe FailIfSlower
parseValue = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> FailIfSlower
FailIfSlower forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Double
parsePositivePercents
optionName :: Tagged FailIfSlower String
optionName = forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"fail-if-slower"
optionHelp :: Tagged FailIfSlower String
optionHelp = forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"Upper bound of acceptable slow down in percents. If a benchmark is unacceptably slower than baseline (see --baseline), it will be reported as failed."
newtype FailIfFaster = FailIfFaster Double
deriving (Int -> FailIfFaster -> ShowS
[FailIfFaster] -> ShowS
FailIfFaster -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FailIfFaster] -> ShowS
$cshowList :: [FailIfFaster] -> ShowS
show :: FailIfFaster -> String
$cshow :: FailIfFaster -> String
showsPrec :: Int -> FailIfFaster -> ShowS
$cshowsPrec :: Int -> FailIfFaster -> ShowS
Show, ReadPrec [FailIfFaster]
ReadPrec FailIfFaster
Int -> ReadS FailIfFaster
ReadS [FailIfFaster]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FailIfFaster]
$creadListPrec :: ReadPrec [FailIfFaster]
readPrec :: ReadPrec FailIfFaster
$creadPrec :: ReadPrec FailIfFaster
readList :: ReadS [FailIfFaster]
$creadList :: ReadS [FailIfFaster]
readsPrec :: Int -> ReadS FailIfFaster
$creadsPrec :: Int -> ReadS FailIfFaster
Read, Typeable)
instance IsOption FailIfFaster where
defaultValue :: FailIfFaster
defaultValue = Double -> FailIfFaster
FailIfFaster (Double
1.0 forall a. Fractional a => a -> a -> a
/ Double
0.0)
parseValue :: String -> Maybe FailIfFaster
parseValue = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> FailIfFaster
FailIfFaster forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Double
parsePositivePercents
optionName :: Tagged FailIfFaster String
optionName = forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"fail-if-faster"
optionHelp :: Tagged FailIfFaster String
optionHelp = forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"Upper bound of acceptable speed up in percents. If a benchmark is unacceptably faster than baseline (see --baseline), it will be reported as failed."
parsePositivePercents :: String -> Maybe Double
parsePositivePercents :: String -> Maybe Double
parsePositivePercents String
xs = do
Double
x <- forall a. Read a => String -> Maybe a
safeRead String
xs
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Double
x forall a. Ord a => a -> a -> Bool
> Double
0)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double
x forall a. Fractional a => a -> a -> a
/ Double
100)
instance IsOption TimeMode where
defaultValue :: TimeMode
defaultValue = TimeMode
CpuTime
parseValue :: String -> Maybe TimeMode
parseValue String
v = case String
v of
String
"cpu" -> forall a. a -> Maybe a
Just TimeMode
CpuTime
String
"wall" -> forall a. a -> Maybe a
Just TimeMode
WallTime
String
_ -> forall a. Maybe a
Nothing
optionName :: Tagged TimeMode String
optionName = forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"time-mode"
optionHelp :: Tagged TimeMode String
optionHelp = forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"Whether to measure CPU time (\"cpu\") or wall-clock time (\"wall\")"
#if MIN_VERSION_tasty(1,3,0)
showDefaultValue :: TimeMode -> Maybe String
showDefaultValue TimeMode
m = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ case TimeMode
m of
TimeMode
CpuTime -> String
"cpu"
TimeMode
WallTime -> String
"wall"
#endif
#endif
newtype Benchmarkable =
Benchmarkable
{ Benchmarkable -> Word64 -> IO ()
unBenchmarkable :: Word64 -> IO ()
} deriving (Typeable)
#ifdef MIN_VERSION_tasty
supportsUnicode :: Bool
#if MIN_VERSION_base(4,5,0)
supportsUnicode :: Bool
supportsUnicode = forall a. Int -> [a] -> [a]
take Int
3 (TextEncoding -> String
textEncodingName TextEncoding
enc) forall a. Eq a => a -> a -> Bool
== String
"UTF"
#if defined(mingw32_HOST_OS)
&& unsafePerformIO getConsoleOutputCP == 65001
#endif
where
enc :: TextEncoding
enc = forall a. IO a -> a
unsafePerformIO IO TextEncoding
getLocaleEncoding
#else
supportsUnicode = False
#endif
{-# NOINLINE supportsUnicode #-}
mu :: Char
mu :: Char
mu = if Bool
supportsUnicode then Char
'μ' else Char
'u'
pm :: String
pm :: String
pm = if Bool
supportsUnicode then String
" ± " else String
" +-"
showPicos3 :: Word64 -> String
showPicos3 :: Word64 -> String
showPicos3 Word64
i
| Double
t forall a. Ord a => a -> a -> Bool
< Double
995 = forall r. PrintfType r => String -> r
printf String
"%3.0f ps" Double
t
| Double
t forall a. Ord a => a -> a -> Bool
< Double
995e1 = forall r. PrintfType r => String -> r
printf String
"%3.1f ns" (Double
t forall a. Fractional a => a -> a -> a
/ Double
1e3)
| Double
t forall a. Ord a => a -> a -> Bool
< Double
995e3 = forall r. PrintfType r => String -> r
printf String
"%3.0f ns" (Double
t forall a. Fractional a => a -> a -> a
/ Double
1e3)
| Double
t forall a. Ord a => a -> a -> Bool
< Double
995e4 = forall r. PrintfType r => String -> r
printf String
"%3.1f %cs" (Double
t forall a. Fractional a => a -> a -> a
/ Double
1e6) Char
mu
| Double
t forall a. Ord a => a -> a -> Bool
< Double
995e6 = forall r. PrintfType r => String -> r
printf String
"%3.0f %cs" (Double
t forall a. Fractional a => a -> a -> a
/ Double
1e6) Char
mu
| Double
t forall a. Ord a => a -> a -> Bool
< Double
995e7 = forall r. PrintfType r => String -> r
printf String
"%3.1f ms" (Double
t forall a. Fractional a => a -> a -> a
/ Double
1e9)
| Double
t forall a. Ord a => a -> a -> Bool
< Double
995e9 = forall r. PrintfType r => String -> r
printf String
"%3.0f ms" (Double
t forall a. Fractional a => a -> a -> a
/ Double
1e9)
| Bool
otherwise = forall r. PrintfType r => String -> r
printf String
"%4.2f s" (Double
t forall a. Fractional a => a -> a -> a
/ Double
1e12)
where
t :: Double
t = Word64 -> Double
word64ToDouble Word64
i
showPicos4 :: Word64 -> String
showPicos4 :: Word64 -> String
showPicos4 Word64
i
| Double
t forall a. Ord a => a -> a -> Bool
< Double
995 = forall r. PrintfType r => String -> r
printf String
"%3.0f ps" Double
t
| Double
t forall a. Ord a => a -> a -> Bool
< Double
995e1 = forall r. PrintfType r => String -> r
printf String
"%4.2f ns" (Double
t forall a. Fractional a => a -> a -> a
/ Double
1e3)
| Double
t forall a. Ord a => a -> a -> Bool
< Double
995e2 = forall r. PrintfType r => String -> r
printf String
"%4.1f ns" (Double
t forall a. Fractional a => a -> a -> a
/ Double
1e3)
| Double
t forall a. Ord a => a -> a -> Bool
< Double
995e3 = forall r. PrintfType r => String -> r
printf String
"%3.0f ns" (Double
t forall a. Fractional a => a -> a -> a
/ Double
1e3)
| Double
t forall a. Ord a => a -> a -> Bool
< Double
995e4 = forall r. PrintfType r => String -> r
printf String
"%4.2f %cs" (Double
t forall a. Fractional a => a -> a -> a
/ Double
1e6) Char
mu
| Double
t forall a. Ord a => a -> a -> Bool
< Double
995e5 = forall r. PrintfType r => String -> r
printf String
"%4.1f %cs" (Double
t forall a. Fractional a => a -> a -> a
/ Double
1e6) Char
mu
| Double
t forall a. Ord a => a -> a -> Bool
< Double
995e6 = forall r. PrintfType r => String -> r
printf String
"%3.0f %cs" (Double
t forall a. Fractional a => a -> a -> a
/ Double
1e6) Char
mu
| Double
t forall a. Ord a => a -> a -> Bool
< Double
995e7 = forall r. PrintfType r => String -> r
printf String
"%4.2f ms" (Double
t forall a. Fractional a => a -> a -> a
/ Double
1e9)
| Double
t forall a. Ord a => a -> a -> Bool
< Double
995e8 = forall r. PrintfType r => String -> r
printf String
"%4.1f ms" (Double
t forall a. Fractional a => a -> a -> a
/ Double
1e9)
| Double
t forall a. Ord a => a -> a -> Bool
< Double
995e9 = forall r. PrintfType r => String -> r
printf String
"%3.0f ms" (Double
t forall a. Fractional a => a -> a -> a
/ Double
1e9)
| Bool
otherwise = forall r. PrintfType r => String -> r
printf String
"%4.3f s" (Double
t forall a. Fractional a => a -> a -> a
/ Double
1e12)
where
t :: Double
t = Word64 -> Double
word64ToDouble Word64
i
showBytes :: Word64 -> String
showBytes :: Word64 -> String
showBytes Word64
i
| Double
t forall a. Ord a => a -> a -> Bool
< Double
1000 = forall r. PrintfType r => String -> r
printf String
"%3.0f B " Double
t
| Double
t forall a. Ord a => a -> a -> Bool
< Double
10189 = forall r. PrintfType r => String -> r
printf String
"%3.1f KB" (Double
t forall a. Fractional a => a -> a -> a
/ Double
1024)
| Double
t forall a. Ord a => a -> a -> Bool
< Double
1023488 = forall r. PrintfType r => String -> r
printf String
"%3.0f KB" (Double
t forall a. Fractional a => a -> a -> a
/ Double
1024)
| Double
t forall a. Ord a => a -> a -> Bool
< Double
10433332 = forall r. PrintfType r => String -> r
printf String
"%3.1f MB" (Double
t forall a. Fractional a => a -> a -> a
/ Double
1048576)
| Double
t forall a. Ord a => a -> a -> Bool
< Double
1048051712 = forall r. PrintfType r => String -> r
printf String
"%3.0f MB" (Double
t forall a. Fractional a => a -> a -> a
/ Double
1048576)
| Double
t forall a. Ord a => a -> a -> Bool
< Double
10683731149 = forall r. PrintfType r => String -> r
printf String
"%3.1f GB" (Double
t forall a. Fractional a => a -> a -> a
/ Double
1073741824)
| Double
t forall a. Ord a => a -> a -> Bool
< Double
1073204953088 = forall r. PrintfType r => String -> r
printf String
"%3.0f GB" (Double
t forall a. Fractional a => a -> a -> a
/ Double
1073741824)
| Double
t forall a. Ord a => a -> a -> Bool
< Double
10940140696372 = forall r. PrintfType r => String -> r
printf String
"%3.1f TB" (Double
t forall a. Fractional a => a -> a -> a
/ Double
1099511627776)
| Double
t forall a. Ord a => a -> a -> Bool
< Double
1098961871962112 = forall r. PrintfType r => String -> r
printf String
"%3.0f TB" (Double
t forall a. Fractional a => a -> a -> a
/ Double
1099511627776)
| Double
t forall a. Ord a => a -> a -> Bool
< Double
11202704073084108 = forall r. PrintfType r => String -> r
printf String
"%3.1f PB" (Double
t forall a. Fractional a => a -> a -> a
/ Double
1125899906842624)
| Double
t forall a. Ord a => a -> a -> Bool
< Double
1125336956889202624 = forall r. PrintfType r => String -> r
printf String
"%3.0f PB" (Double
t forall a. Fractional a => a -> a -> a
/ Double
1125899906842624)
| Double
t forall a. Ord a => a -> a -> Bool
< Double
11471568970838126592 = forall r. PrintfType r => String -> r
printf String
"%3.1f EB" (Double
t forall a. Fractional a => a -> a -> a
/ Double
1152921504606846976)
| Bool
otherwise = forall r. PrintfType r => String -> r
printf String
"%3.0f EB" (Double
t forall a. Fractional a => a -> a -> a
/ Double
1152921504606846976)
where
t :: Double
t = Word64 -> Double
word64ToDouble Word64
i
#endif
data Measurement = Measurement
{ Measurement -> Word64
measTime :: !Word64
, Measurement -> Word64
measAllocs :: !Word64
, Measurement -> Word64
measCopied :: !Word64
, Measurement -> Word64
measMaxMem :: !Word64
} deriving (Int -> Measurement -> ShowS
[Measurement] -> ShowS
Measurement -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Measurement] -> ShowS
$cshowList :: [Measurement] -> ShowS
show :: Measurement -> String
$cshow :: Measurement -> String
showsPrec :: Int -> Measurement -> ShowS
$cshowsPrec :: Int -> Measurement -> ShowS
Show, ReadPrec [Measurement]
ReadPrec Measurement
Int -> ReadS Measurement
ReadS [Measurement]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Measurement]
$creadListPrec :: ReadPrec [Measurement]
readPrec :: ReadPrec Measurement
$creadPrec :: ReadPrec Measurement
readList :: ReadS [Measurement]
$creadList :: ReadS [Measurement]
readsPrec :: Int -> ReadS Measurement
$creadsPrec :: Int -> ReadS Measurement
Read)
data Estimate = Estimate
{ Estimate -> Measurement
estMean :: !Measurement
, Estimate -> Word64
estStdev :: !Word64
} deriving (Int -> Estimate -> ShowS
[Estimate] -> ShowS
Estimate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Estimate] -> ShowS
$cshowList :: [Estimate] -> ShowS
show :: Estimate -> String
$cshow :: Estimate -> String
showsPrec :: Int -> Estimate -> ShowS
$cshowsPrec :: Int -> Estimate -> ShowS
Show, ReadPrec [Estimate]
ReadPrec Estimate
Int -> ReadS Estimate
ReadS [Estimate]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Estimate]
$creadListPrec :: ReadPrec [Estimate]
readPrec :: ReadPrec Estimate
$creadPrec :: ReadPrec Estimate
readList :: ReadS [Estimate]
$creadList :: ReadS [Estimate]
readsPrec :: Int -> ReadS Estimate
$creadsPrec :: Int -> ReadS Estimate
Read)
#ifdef MIN_VERSION_tasty
data WithLoHi a = WithLoHi
!a
!Double
!Double
deriving (Int -> WithLoHi a -> ShowS
forall a. Show a => Int -> WithLoHi a -> ShowS
forall a. Show a => [WithLoHi a] -> ShowS
forall a. Show a => WithLoHi a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WithLoHi a] -> ShowS
$cshowList :: forall a. Show a => [WithLoHi a] -> ShowS
show :: WithLoHi a -> String
$cshow :: forall a. Show a => WithLoHi a -> String
showsPrec :: Int -> WithLoHi a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> WithLoHi a -> ShowS
Show, ReadPrec [WithLoHi a]
ReadPrec (WithLoHi a)
ReadS [WithLoHi a]
forall a. Read a => ReadPrec [WithLoHi a]
forall a. Read a => ReadPrec (WithLoHi a)
forall a. Read a => Int -> ReadS (WithLoHi a)
forall a. Read a => ReadS [WithLoHi a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WithLoHi a]
$creadListPrec :: forall a. Read a => ReadPrec [WithLoHi a]
readPrec :: ReadPrec (WithLoHi a)
$creadPrec :: forall a. Read a => ReadPrec (WithLoHi a)
readList :: ReadS [WithLoHi a]
$creadList :: forall a. Read a => ReadS [WithLoHi a]
readsPrec :: Int -> ReadS (WithLoHi a)
$creadsPrec :: forall a. Read a => Int -> ReadS (WithLoHi a)
Read)
prettyEstimate :: Estimate -> String
prettyEstimate :: Estimate -> String
prettyEstimate (Estimate Measurement
m Word64
stdev) =
Word64 -> String
showPicos4 (Measurement -> Word64
measTime Measurement
m)
forall a. [a] -> [a] -> [a]
++ (if Word64
stdev forall a. Eq a => a -> a -> Bool
== Word64
0 then String
" " else String
pm forall a. [a] -> [a] -> [a]
++ Word64 -> String
showPicos3 (Word64
2 forall a. Num a => a -> a -> a
* Word64
stdev))
prettyEstimateWithGC :: Estimate -> String
prettyEstimateWithGC :: Estimate -> String
prettyEstimateWithGC (Estimate Measurement
m Word64
stdev) =
Word64 -> String
showPicos4 (Measurement -> Word64
measTime Measurement
m)
forall a. [a] -> [a] -> [a]
++ (if Word64
stdev forall a. Eq a => a -> a -> Bool
== Word64
0 then String
", " else String
pm forall a. [a] -> [a] -> [a]
++ Word64 -> String
showPicos3 (Word64
2 forall a. Num a => a -> a -> a
* Word64
stdev) forall a. [a] -> [a] -> [a]
++ String
", ")
forall a. [a] -> [a] -> [a]
++ Word64 -> String
showBytes (Measurement -> Word64
measAllocs Measurement
m) forall a. [a] -> [a] -> [a]
++ String
" allocated, "
forall a. [a] -> [a] -> [a]
++ Word64 -> String
showBytes (Measurement -> Word64
measCopied Measurement
m) forall a. [a] -> [a] -> [a]
++ String
" copied, "
forall a. [a] -> [a] -> [a]
++ Word64 -> String
showBytes (Measurement -> Word64
measMaxMem Measurement
m) forall a. [a] -> [a] -> [a]
++ String
" peak memory"
csvEstimate :: Estimate -> String
csvEstimate :: Estimate -> String
csvEstimate (Estimate Measurement
m Word64
stdev) = forall a. Show a => a -> String
show (Measurement -> Word64
measTime Measurement
m) forall a. [a] -> [a] -> [a]
++ String
"," forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Word64
2 forall a. Num a => a -> a -> a
* Word64
stdev)
csvEstimateWithGC :: Estimate -> String
csvEstimateWithGC :: Estimate -> String
csvEstimateWithGC (Estimate Measurement
m Word64
stdev) = forall a. Show a => a -> String
show (Measurement -> Word64
measTime Measurement
m) forall a. [a] -> [a] -> [a]
++ String
"," forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Word64
2 forall a. Num a => a -> a -> a
* Word64
stdev)
forall a. [a] -> [a] -> [a]
++ String
"," forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Measurement -> Word64
measAllocs Measurement
m) forall a. [a] -> [a] -> [a]
++ String
"," forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Measurement -> Word64
measCopied Measurement
m) forall a. [a] -> [a] -> [a]
++ String
"," forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Measurement -> Word64
measMaxMem Measurement
m)
#endif
predict
:: Measurement
-> Measurement
-> Estimate
predict :: Measurement -> Measurement -> Estimate
predict (Measurement Word64
t1 Word64
a1 Word64
c1 Word64
m1) (Measurement Word64
t2 Word64
a2 Word64
c2 Word64
m2) = Estimate
{ estMean :: Measurement
estMean = Word64 -> Word64 -> Word64 -> Word64 -> Measurement
Measurement Word64
t (forall {a}. Integral a => a -> a -> a
fit Word64
a1 Word64
a2) (forall {a}. Integral a => a -> a -> a
fit Word64
c1 Word64
c2) (forall a. Ord a => a -> a -> a
max Word64
m1 Word64
m2)
, estStdev :: Word64
estStdev = forall a b. (RealFrac a, Integral b) => a -> b
truncate (forall a. Floating a => a -> a
sqrt Double
d :: Double)
}
where
fit :: a -> a -> a
fit a
x1 a
x2 = a
x1 forall {a}. Integral a => a -> a -> a
`quot` a
5 forall a. Num a => a -> a -> a
+ a
2 forall a. Num a => a -> a -> a
* (a
x2 forall {a}. Integral a => a -> a -> a
`quot` a
5)
t :: Word64
t = forall {a}. Integral a => a -> a -> a
fit Word64
t1 Word64
t2
sqr :: a -> a
sqr a
x = a
x forall a. Num a => a -> a -> a
* a
x
d :: Double
d = forall {a}. Num a => a -> a
sqr (Word64 -> Double
word64ToDouble Word64
t1 forall a. Num a => a -> a -> a
- Word64 -> Double
word64ToDouble Word64
t)
forall a. Num a => a -> a -> a
+ forall {a}. Num a => a -> a
sqr (Word64 -> Double
word64ToDouble Word64
t2 forall a. Num a => a -> a -> a
- Double
2 forall a. Num a => a -> a -> a
* Word64 -> Double
word64ToDouble Word64
t)
predictPerturbed :: Measurement -> Measurement -> Estimate
predictPerturbed :: Measurement -> Measurement -> Estimate
predictPerturbed Measurement
t1 Measurement
t2 = Estimate
{ estMean :: Measurement
estMean = Estimate -> Measurement
estMean (Measurement -> Measurement -> Estimate
predict Measurement
t1 Measurement
t2)
, estStdev :: Word64
estStdev = forall a. Ord a => a -> a -> a
max
(Estimate -> Word64
estStdev (Measurement -> Measurement -> Estimate
predict (Measurement -> Measurement
lo Measurement
t1) (Measurement -> Measurement
hi Measurement
t2)))
(Estimate -> Word64
estStdev (Measurement -> Measurement -> Estimate
predict (Measurement -> Measurement
hi Measurement
t1) (Measurement -> Measurement
lo Measurement
t2)))
}
where
prec :: Word64
prec = forall a. Ord a => a -> a -> a
max (forall a. Num a => Integer -> a
fromInteger Integer
cpuTimePrecision) Word64
1000000000
hi :: Measurement -> Measurement
hi Measurement
meas = Measurement
meas { measTime :: Word64
measTime = Measurement -> Word64
measTime Measurement
meas forall a. Num a => a -> a -> a
+ Word64
prec }
lo :: Measurement -> Measurement
lo Measurement
meas = Measurement
meas { measTime :: Word64
measTime = Measurement -> Word64
measTime Measurement
meas forall a. Num a => a -> a -> a
- Word64
prec }
hasGCStats :: Bool
#if MIN_VERSION_base(4,10,0)
hasGCStats :: Bool
hasGCStats = forall a. IO a -> a
unsafePerformIO IO Bool
getRTSStatsEnabled
#elif MIN_VERSION_base(4,6,0)
hasGCStats = unsafePerformIO getGCStatsEnabled
#else
hasGCStats = False
#endif
getAllocsAndCopied :: IO (Word64, Word64, Word64)
getAllocsAndCopied :: IO (Word64, Word64, Word64)
getAllocsAndCopied = do
if Bool -> Bool
not Bool
hasGCStats then forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64
0, Word64
0, Word64
0) else
#if MIN_VERSION_base(4,10,0)
(\RTSStats
s -> (RTSStats -> Word64
allocated_bytes RTSStats
s, RTSStats -> Word64
copied_bytes RTSStats
s, RTSStats -> Word64
max_mem_in_use_bytes RTSStats
s)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO RTSStats
getRTSStats
#elif MIN_VERSION_base(4,6,0)
(\s -> (int64ToWord64 $ bytesAllocated s, int64ToWord64 $ bytesCopied s, int64ToWord64 $ peakMegabytesAllocated s * 1024 * 1024)) <$> getGCStats
#else
pure (0, 0, 0)
#endif
getTimePicoSecs :: TimeMode -> IO Word64
getTimePicoSecs :: TimeMode -> IO Word64
getTimePicoSecs TimeMode
timeMode = case TimeMode
timeMode of
TimeMode
CpuTime -> forall a. Num a => Integer -> a
fromInteger forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Integer
getCPUTime
#ifdef MIN_VERSION_tasty
TimeMode
WallTime -> forall a b. (RealFrac a, Integral b) => a -> b
round forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double
1e12 forall a. Num a => a -> a -> a
*) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Double
getTime
#endif
measure :: TimeMode -> Word64 -> Benchmarkable -> IO Measurement
measure :: TimeMode -> Word64 -> Benchmarkable -> IO Measurement
measure TimeMode
timeMode Word64
n (Benchmarkable Word64 -> IO ()
act) = do
let getTimePicoSecs' :: IO Word64
getTimePicoSecs' = TimeMode -> IO Word64
getTimePicoSecs TimeMode
timeMode
IO ()
performGC
Word64
startTime <- IO Word64
getTimePicoSecs'
(Word64
startAllocs, Word64
startCopied, Word64
startMaxMemInUse) <- IO (Word64, Word64, Word64)
getAllocsAndCopied
Word64 -> IO ()
act Word64
n
Word64
endTime <- IO Word64
getTimePicoSecs'
(Word64
endAllocs, Word64
endCopied, Word64
endMaxMemInUse) <- IO (Word64, Word64, Word64)
getAllocsAndCopied
let meas :: Measurement
meas = Measurement
{ measTime :: Word64
measTime = Word64
endTime forall a. Num a => a -> a -> a
- Word64
startTime
, measAllocs :: Word64
measAllocs = Word64
endAllocs forall a. Num a => a -> a -> a
- Word64
startAllocs
, measCopied :: Word64
measCopied = Word64
endCopied forall a. Num a => a -> a -> a
- Word64
startCopied
, measMaxMem :: Word64
measMaxMem = forall a. Ord a => a -> a -> a
max Word64
endMaxMemInUse Word64
startMaxMemInUse
}
#ifdef DEBUG
pure $ trace (show n ++ (if n == 1 then " iteration gives " else " iterations give ") ++ show meas) meas
#else
forall (f :: * -> *) a. Applicative f => a -> f a
pure Measurement
meas
#endif
measureUntil :: TimeMode -> Bool -> Timeout -> RelStDev -> Benchmarkable -> IO Estimate
measureUntil :: TimeMode
-> Bool -> Timeout -> RelStDev -> Benchmarkable -> IO Estimate
measureUntil TimeMode
timeMode Bool
_ Timeout
_ (RelStDev Double
targetRelStDev) Benchmarkable
b
| forall a. RealFloat a => a -> Bool
isInfinite Double
targetRelStDev, Double
targetRelStDev forall a. Ord a => a -> a -> Bool
> Double
0 = do
Measurement
t1 <- TimeMode -> Word64 -> Benchmarkable -> IO Measurement
measure TimeMode
timeMode Word64
1 Benchmarkable
b
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Estimate { estMean :: Measurement
estMean = Measurement
t1, estStdev :: Word64
estStdev = Word64
0 }
measureUntil TimeMode
timeMode Bool
warnIfNoTimeout Timeout
timeout (RelStDev Double
targetRelStDev) Benchmarkable
b = do
Measurement
t1 <- Word64 -> Benchmarkable -> IO Measurement
measure' Word64
1 Benchmarkable
b
Word64 -> Measurement -> Word64 -> IO Estimate
go Word64
1 Measurement
t1 Word64
0
where
measure' :: Word64 -> Benchmarkable -> IO Measurement
measure' = TimeMode -> Word64 -> Benchmarkable -> IO Measurement
measure TimeMode
timeMode
go :: Word64 -> Measurement -> Word64 -> IO Estimate
go :: Word64 -> Measurement -> Word64 -> IO Estimate
go Word64
n Measurement
t1 Word64
sumOfTs = do
Measurement
t2 <- Word64 -> Benchmarkable -> IO Measurement
measure' (Word64
2 forall a. Num a => a -> a -> a
* Word64
n) Benchmarkable
b
let Estimate (Measurement Word64
meanN Word64
allocN Word64
copiedN Word64
maxMemN) Word64
stdevN = Measurement -> Measurement -> Estimate
predictPerturbed Measurement
t1 Measurement
t2
isTimeoutSoon :: Bool
isTimeoutSoon = case Timeout
timeout of
Timeout
NoTimeout -> Bool
False
Timeout Integer
micros String
_ -> (Word64
sumOfTs' forall a. Num a => a -> a -> a
+ Word64
3 forall a. Num a => a -> a -> a
* Measurement -> Word64
measTime Measurement
t2) forall {a}. Integral a => a -> a -> a
`quot` (Word64
1000000 forall a. Num a => a -> a -> a
* Word64
10 forall {a}. Integral a => a -> a -> a
`quot` Word64
12) forall a. Ord a => a -> a -> Bool
>= forall a. Num a => Integer -> a
fromInteger Integer
micros
isStDevInTargetRange :: Bool
isStDevInTargetRange = Word64
stdevN forall a. Ord a => a -> a -> Bool
< forall a b. (RealFrac a, Integral b) => a -> b
truncate (forall a. Ord a => a -> a -> a
max Double
0 Double
targetRelStDev forall a. Num a => a -> a -> a
* Word64 -> Double
word64ToDouble Word64
meanN)
scale :: Word64 -> Word64
scale = (forall {a}. Integral a => a -> a -> a
`quot` Word64
n)
sumOfTs' :: Word64
sumOfTs' = Word64
sumOfTs forall a. Num a => a -> a -> a
+ Measurement -> Word64
measTime Measurement
t1
case Timeout
timeout of
Timeout
NoTimeout | Bool
warnIfNoTimeout, Word64
sumOfTs' forall a. Num a => a -> a -> a
+ Measurement -> Word64
measTime Measurement
t2 forall a. Ord a => a -> a -> Bool
> Word64
100 forall a. Num a => a -> a -> a
* Word64
1000000000000
-> Handle -> String -> IO ()
hPutStrLn Handle
stderr String
"This benchmark takes more than 100 seconds. Consider setting --timeout, if this is unexpected (or to silence this warning)."
Timeout
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
if Bool
isStDevInTargetRange Bool -> Bool -> Bool
|| Bool
isTimeoutSoon
then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Estimate
{ estMean :: Measurement
estMean = Word64 -> Word64 -> Word64 -> Word64 -> Measurement
Measurement (Word64 -> Word64
scale Word64
meanN) (Word64 -> Word64
scale Word64
allocN) (Word64 -> Word64
scale Word64
copiedN) Word64
maxMemN
, estStdev :: Word64
estStdev = Word64 -> Word64
scale Word64
stdevN }
else Word64 -> Measurement -> Word64 -> IO Estimate
go (Word64
2 forall a. Num a => a -> a -> a
* Word64
n) Measurement
t2 Word64
sumOfTs'
measureCpuTime :: Timeout -> RelStDev -> Benchmarkable -> IO Double
measureCpuTime :: Timeout -> RelStDev -> Benchmarkable -> IO Double
measureCpuTime
= ((forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((forall a. Fractional a => a -> a -> a
/ Double
1e12) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Double
word64ToDouble forall b c a. (b -> c) -> (a -> b) -> a -> c
. Measurement -> Word64
measTime forall b c a. (b -> c) -> (a -> b) -> a -> c
. Estimate -> Measurement
estMean) forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
.)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeMode
-> Bool -> Timeout -> RelStDev -> Benchmarkable -> IO Estimate
measureUntil TimeMode
CpuTime Bool
False
#ifdef MIN_VERSION_tasty
instance IsTest Benchmarkable where
testOptions :: Tagged Benchmarkable [OptionDescription]
testOptions = forall (f :: * -> *) a. Applicative f => a -> f a
pure
[ forall v. IsOption v => Proxy v -> OptionDescription
Option (forall {k} (t :: k). Proxy t
Proxy :: Proxy RelStDev)
, forall v. IsOption v => Proxy v -> OptionDescription
Option (forall {k} (t :: k). Proxy t
Proxy :: Proxy FailIfSlower)
, forall v. IsOption v => Proxy v -> OptionDescription
Option (forall {k} (t :: k). Proxy t
Proxy :: Proxy FailIfFaster)
, forall v. IsOption v => Proxy v -> OptionDescription
Option (forall {k} (t :: k). Proxy t
Proxy :: Proxy TimeMode)
]
run :: OptionSet -> Benchmarkable -> (Progress -> IO ()) -> IO Result
run OptionSet
opts Benchmarkable
b = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ case NumThreads -> Int
getNumThreads (forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
opts) of
Int
1 -> do
let timeMode :: TimeMode
timeMode = forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
opts
Estimate
est <- TimeMode
-> Bool -> Timeout -> RelStDev -> Benchmarkable -> IO Estimate
measureUntil TimeMode
timeMode Bool
True (forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
opts) (forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
opts) Benchmarkable
b
let FailIfSlower Double
ifSlower = forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
opts
FailIfFaster Double
ifFaster = forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
opts
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ String -> Result
testPassed forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show (forall a. a -> Double -> Double -> WithLoHi a
WithLoHi Estimate
est (Double
1 forall a. Num a => a -> a -> a
- Double
ifFaster) (Double
1 forall a. Num a => a -> a -> a
+ Double
ifSlower))
Int
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ String -> Result
testFailed String
"Benchmarks must not be run concurrently. Please pass -j1 and/or avoid +RTS -N."
bench :: String -> Benchmarkable -> Benchmark
bench :: String -> Benchmarkable -> Benchmark
bench = forall t. IsTest t => String -> t -> Benchmark
singleTest
bgroup :: String -> [Benchmark] -> Benchmark
bgroup :: String -> [Benchmark] -> Benchmark
bgroup = String -> [Benchmark] -> Benchmark
testGroup
bcompare
:: String
-> Benchmark
-> Benchmark
bcompare :: String -> Benchmark -> Benchmark
bcompare = Double -> Double -> String -> Benchmark -> Benchmark
bcompareWithin (-Double
1forall a. Fractional a => a -> a -> a
/Double
0) (Double
1forall a. Fractional a => a -> a -> a
/Double
0)
bcompareWithin
:: Double
-> Double
-> String
-> Benchmark
-> Benchmark
bcompareWithin :: Double -> Double -> String -> Benchmark -> Benchmark
bcompareWithin Double
lo Double
hi String
s = case String -> Maybe Expr
parseExpr String
s of
Maybe Expr
Nothing -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Could not parse bcompare pattern " forall a. [a] -> [a] -> [a]
++ String
s
Just Expr
e -> DependencyType -> Expr -> Benchmark -> Benchmark
after_ DependencyType
AllSucceed (Expr -> Expr -> Expr
And (String -> Expr
StringLit (String
bcomparePrefix forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Double
lo, Double
hi))) Expr
e)
bcomparePrefix :: String
bcomparePrefix :: String
bcomparePrefix = String
"tasty-bench"
type Benchmark = TestTree
defaultMain :: [Benchmark] -> IO ()
defaultMain :: [Benchmark] -> IO ()
defaultMain [Benchmark]
bs = do
let act :: IO ()
act = [Ingredient] -> Benchmark -> IO ()
Test.Tasty.defaultMainWithIngredients [Ingredient]
benchIngredients forall a b. (a -> b) -> a -> b
$ String -> [Benchmark] -> Benchmark
testGroup String
"All" [Benchmark]
bs
#if MIN_VERSION_base(4,5,0)
TextEncoding -> IO ()
setLocaleEncoding TextEncoding
utf8
#endif
#if defined(mingw32_HOST_OS)
codePage <- getConsoleOutputCP
bracket (setConsoleOutputCP 65001) (const $ setConsoleOutputCP codePage) (const act)
#else
IO ()
act
#endif
benchIngredients :: [Ingredient]
benchIngredients :: [Ingredient]
benchIngredients = [Ingredient
listingTests, Ingredient -> Ingredient -> Ingredient
composeReporters Ingredient
consoleBenchReporter (Ingredient -> Ingredient -> Ingredient
composeReporters Ingredient
csvReporter Ingredient
svgReporter)]
#endif
funcToBench :: forall a b c. (b -> c) -> (a -> b) -> a -> Benchmarkable
funcToBench :: forall a b c. (b -> c) -> (a -> b) -> a -> Benchmarkable
funcToBench b -> c
frc = ((Word64 -> IO ()) -> Benchmarkable
Benchmarkable forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. SPEC -> (a -> b) -> a -> Word64 -> IO ()
benchLoop SPEC
SPEC
where
benchLoop :: SPEC -> (a -> b) -> a -> Word64 -> IO ()
benchLoop :: SPEC -> (a -> b) -> a -> Word64 -> IO ()
benchLoop !SPEC
_ a -> b
f a
x Word64
n
| Word64
n forall a. Eq a => a -> a -> Bool
== Word64
0 = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
| Bool
otherwise = do
c
_ <- forall a. a -> IO a
evaluate (b -> c
frc (a -> b
f a
x))
SPEC -> (a -> b) -> a -> Word64 -> IO ()
benchLoop SPEC
SPEC a -> b
f a
x (Word64
n forall a. Num a => a -> a -> a
- Word64
1)
{-# INLINE funcToBench #-}
nf :: NFData b => (a -> b) -> a -> Benchmarkable
nf :: forall b a. NFData b => (a -> b) -> a -> Benchmarkable
nf = forall a b c. (b -> c) -> (a -> b) -> a -> Benchmarkable
funcToBench forall a. NFData a => a -> a
force
{-# INLINE nf #-}
whnf :: (a -> b) -> a -> Benchmarkable
whnf :: forall a b. (a -> b) -> a -> Benchmarkable
whnf = forall a b c. (b -> c) -> (a -> b) -> a -> Benchmarkable
funcToBench forall a. a -> a
id
{-# INLINE whnf #-}
ioToBench :: (b -> c) -> IO b -> Benchmarkable
ioToBench :: forall b c. (b -> c) -> IO b -> Benchmarkable
ioToBench b -> c
frc IO b
act = (Word64 -> IO ()) -> Benchmarkable
Benchmarkable forall {t}. (Eq t, Num t) => t -> IO ()
go
where
go :: t -> IO ()
go t
n
| t
n forall a. Eq a => a -> a -> Bool
== t
0 = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
| Bool
otherwise = do
b
val <- IO b
act
c
_ <- forall a. a -> IO a
evaluate (b -> c
frc b
val)
t -> IO ()
go (t
n forall a. Num a => a -> a -> a
- t
1)
{-# INLINE ioToBench #-}
nfIO :: NFData a => IO a -> Benchmarkable
nfIO :: forall a. NFData a => IO a -> Benchmarkable
nfIO = forall b c. (b -> c) -> IO b -> Benchmarkable
ioToBench forall a. NFData a => a -> a
force
{-# INLINE nfIO #-}
whnfIO :: IO a -> Benchmarkable
whnfIO :: forall a. IO a -> Benchmarkable
whnfIO = forall b c. (b -> c) -> IO b -> Benchmarkable
ioToBench forall a. a -> a
id
{-# INLINE whnfIO #-}
ioFuncToBench :: (b -> c) -> (a -> IO b) -> a -> Benchmarkable
ioFuncToBench :: forall b c a. (b -> c) -> (a -> IO b) -> a -> Benchmarkable
ioFuncToBench b -> c
frc = ((Word64 -> IO ()) -> Benchmarkable
Benchmarkable forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {t} {t}. (Eq t, Num t) => (t -> IO b) -> t -> t -> IO ()
go
where
go :: (t -> IO b) -> t -> t -> IO ()
go t -> IO b
f t
x t
n
| t
n forall a. Eq a => a -> a -> Bool
== t
0 = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
| Bool
otherwise = do
b
val <- t -> IO b
f t
x
c
_ <- forall a. a -> IO a
evaluate (b -> c
frc b
val)
(t -> IO b) -> t -> t -> IO ()
go t -> IO b
f t
x (t
n forall a. Num a => a -> a -> a
- t
1)
{-# INLINE ioFuncToBench #-}
nfAppIO :: NFData b => (a -> IO b) -> a -> Benchmarkable
nfAppIO :: forall b a. NFData b => (a -> IO b) -> a -> Benchmarkable
nfAppIO = forall b c a. (b -> c) -> (a -> IO b) -> a -> Benchmarkable
ioFuncToBench forall a. NFData a => a -> a
force
{-# INLINE nfAppIO #-}
whnfAppIO :: (a -> IO b) -> a -> Benchmarkable
whnfAppIO :: forall a b. (a -> IO b) -> a -> Benchmarkable
whnfAppIO = forall b c a. (b -> c) -> (a -> IO b) -> a -> Benchmarkable
ioFuncToBench forall a. a -> a
id
{-# INLINE whnfAppIO #-}
#ifdef MIN_VERSION_tasty
env :: NFData env => IO env -> (env -> Benchmark) -> Benchmark
env :: forall env. NFData env => IO env -> (env -> Benchmark) -> Benchmark
env IO env
res = forall env a.
NFData env =>
IO env -> (env -> IO a) -> (env -> Benchmark) -> Benchmark
envWithCleanup IO env
res (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
envWithCleanup :: NFData env => IO env -> (env -> IO a) -> (env -> Benchmark) -> Benchmark
envWithCleanup :: forall env a.
NFData env =>
IO env -> (env -> IO a) -> (env -> Benchmark) -> Benchmark
envWithCleanup IO env
res env -> IO a
fin env -> Benchmark
f = forall a. IO a -> (a -> IO ()) -> (IO a -> Benchmark) -> Benchmark
withResource
(IO env
res forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. a -> IO a
evaluate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NFData a => a -> a
force)
(forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. env -> IO a
fin)
(env -> Benchmark
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IO a -> a
unsafePerformIO)
newtype CsvPath = CsvPath FilePath
deriving (Typeable)
instance IsOption (Maybe CsvPath) where
defaultValue :: Maybe CsvPath
defaultValue = forall a. Maybe a
Nothing
parseValue :: String -> Maybe (Maybe CsvPath)
parseValue = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CsvPath
CsvPath
optionName :: Tagged (Maybe CsvPath) String
optionName = forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"csv"
optionHelp :: Tagged (Maybe CsvPath) String
optionHelp = forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"File to write results in CSV format"
csvReporter :: Ingredient
csvReporter :: Ingredient
csvReporter = [OptionDescription]
-> (OptionSet
-> Benchmark -> Maybe (StatusMap -> IO (Double -> IO Bool)))
-> Ingredient
TestReporter [forall v. IsOption v => Proxy v -> OptionDescription
Option (forall {k} (t :: k). Proxy t
Proxy :: Proxy (Maybe CsvPath))] forall a b. (a -> b) -> a -> b
$
\OptionSet
opts Benchmark
tree -> do
CsvPath String
path <- forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
opts
let names :: [String]
names = OptionSet -> Benchmark -> [String]
testsNames OptionSet
opts Benchmark
tree
namesMap :: IntMap String
namesMap = forall a. [(Int, a)] -> IntMap a
IM.fromDistinctAscList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [String]
names
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ \StatusMap
smap -> do
case forall a. Ord a => [a] -> Maybe a
findNonUniqueElement [String]
names of
Maybe String
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just String
name -> do
Handle -> String -> IO ()
hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$ String
"CSV report cannot proceed, because name '" forall a. [a] -> [a] -> [a]
++ String
name forall a. [a] -> [a] -> [a]
++ String
"' corresponds to two or more benchmarks. Please disambiguate them."
forall a. IO a
exitFailure
let augmented :: IntMap (String, TVar Status)
augmented = forall a b c. (a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
IM.intersectionWith (,) IntMap String
namesMap StatusMap
smap
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
(do
Handle
h <- String -> IOMode -> IO Handle
openFile String
path IOMode
WriteMode
Handle -> BufferMode -> IO ()
hSetBuffering Handle
h BufferMode
LineBuffering
Handle -> String -> IO ()
hPutStrLn Handle
h forall a b. (a -> b) -> a -> b
$ String
"Name,Mean (ps),2*Stdev (ps)" forall a. [a] -> [a] -> [a]
++
(if Bool
hasGCStats then String
",Allocated,Copied,Peak Memory" else String
"")
forall (f :: * -> *) a. Applicative f => a -> f a
pure Handle
h
)
Handle -> IO ()
hClose
(Handle -> IntMap (String, TVar Status) -> IO ()
`csvOutput` IntMap (String, TVar Status)
augmented)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ StatusMap -> IO Bool
isSuccessful StatusMap
smap
findNonUniqueElement :: Ord a => [a] -> Maybe a
findNonUniqueElement :: forall a. Ord a => [a] -> Maybe a
findNonUniqueElement = forall {a}. Ord a => Set a -> [a] -> Maybe a
go forall a. Set a
S.empty
where
go :: Set a -> [a] -> Maybe a
go Set a
_ [] = forall a. Maybe a
Nothing
go Set a
acc (a
x : [a]
xs)
| a
x forall a. Ord a => a -> Set a -> Bool
`S.member` Set a
acc = forall a. a -> Maybe a
Just a
x
| Bool
otherwise = Set a -> [a] -> Maybe a
go (forall a. Ord a => a -> Set a -> Set a
S.insert a
x Set a
acc) [a]
xs
csvOutput :: Handle -> IntMap (TestName, TVar Status) -> IO ()
csvOutput :: Handle -> IntMap (String, TVar Status) -> IO ()
csvOutput Handle
h = forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ forall a b. (a -> b) -> a -> b
$ \(String
name, TVar Status
tv) -> do
let csv :: Estimate -> String
csv = if Bool
hasGCStats then Estimate -> String
csvEstimateWithGC else Estimate -> String
csvEstimate
Result
r <- forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TVar a -> STM a
readTVar TVar Status
tv forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Status
s -> case Status
s of Done Result
r -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Result
r; Status
_ -> forall a. STM a
retry
case forall a. Read a => String -> Maybe a
safeRead (Result -> String
resultDescription Result
r) of
Maybe (WithLoHi Estimate)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just (WithLoHi Estimate
est Double
_ Double
_) -> do
String
msg <- String -> IO String
formatMessage forall a b. (a -> b) -> a -> b
$ Estimate -> String
csv Estimate
est
Handle -> String -> IO ()
hPutStrLn Handle
h (ShowS
encodeCsv String
name forall a. [a] -> [a] -> [a]
++ Char
',' forall a. a -> [a] -> [a]
: String
msg)
encodeCsv :: String -> String
encodeCsv :: ShowS
encodeCsv String
xs
| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
xs) String
",\"\n\r"
= Char
'"' forall a. a -> [a] -> [a]
: ShowS
go String
xs
| Bool
otherwise = String
xs
where
go :: ShowS
go [] = Char
'"' forall a. a -> [a] -> [a]
: []
go (Char
'"' : String
ys) = Char
'"' forall a. a -> [a] -> [a]
: Char
'"' forall a. a -> [a] -> [a]
: ShowS
go String
ys
go (Char
y : String
ys) = Char
y forall a. a -> [a] -> [a]
: ShowS
go String
ys
newtype SvgPath = SvgPath FilePath
deriving (Typeable)
instance IsOption (Maybe SvgPath) where
defaultValue :: Maybe SvgPath
defaultValue = forall a. Maybe a
Nothing
parseValue :: String -> Maybe (Maybe SvgPath)
parseValue = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> SvgPath
SvgPath
optionName :: Tagged (Maybe SvgPath) String
optionName = forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"svg"
optionHelp :: Tagged (Maybe SvgPath) String
optionHelp = forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"File to plot results in SVG format"
svgReporter :: Ingredient
svgReporter :: Ingredient
svgReporter = [OptionDescription]
-> (OptionSet
-> Benchmark -> Maybe (StatusMap -> IO (Double -> IO Bool)))
-> Ingredient
TestReporter [forall v. IsOption v => Proxy v -> OptionDescription
Option (forall {k} (t :: k). Proxy t
Proxy :: Proxy (Maybe SvgPath))] forall a b. (a -> b) -> a -> b
$
\OptionSet
opts Benchmark
tree -> do
SvgPath String
path <- forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
opts
let names :: [String]
names = OptionSet -> Benchmark -> [String]
testsNames OptionSet
opts Benchmark
tree
namesMap :: IntMap String
namesMap = forall a. [(Int, a)] -> IntMap a
IM.fromDistinctAscList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [String]
names
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ \StatusMap
smap -> do
IORef [(String, Estimate)]
ref <- forall a. a -> IO (IORef a)
newIORef []
IORef [(String, Estimate)] -> IntMap (String, TVar Status) -> IO ()
svgCollect IORef [(String, Estimate)]
ref (forall a b c. (a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
IM.intersectionWith (,) IntMap String
namesMap StatusMap
smap)
[(String, Estimate)]
res <- forall a. IORef a -> IO a
readIORef IORef [(String, Estimate)]
ref
String -> String -> IO ()
writeFile String
path ([(String, Estimate)] -> String
svgRender (forall a. [a] -> [a]
reverse [(String, Estimate)]
res))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ StatusMap -> IO Bool
isSuccessful StatusMap
smap
isSuccessful :: StatusMap -> IO Bool
isSuccessful :: StatusMap -> IO Bool
isSuccessful = [TVar Status] -> IO Bool
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IntMap a -> [a]
IM.elems
where
go :: [TVar Status] -> IO Bool
go [] = forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
go (TVar Status
tv : [TVar Status]
tvs) = do
Bool
b <- forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TVar a -> STM a
readTVar TVar Status
tv forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Status
s -> case Status
s of Done Result
r -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result -> Bool
resultSuccessful Result
r); Status
_ -> forall a. STM a
retry
if Bool
b then [TVar Status] -> IO Bool
go [TVar Status]
tvs else forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
svgCollect :: IORef [(TestName, Estimate)] -> IntMap (TestName, TVar Status) -> IO ()
svgCollect :: IORef [(String, Estimate)] -> IntMap (String, TVar Status) -> IO ()
svgCollect IORef [(String, Estimate)]
ref = forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ forall a b. (a -> b) -> a -> b
$ \(String
name, TVar Status
tv) -> do
Result
r <- forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TVar a -> STM a
readTVar TVar Status
tv forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Status
s -> case Status
s of Done Result
r -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Result
r; Status
_ -> forall a. STM a
retry
case forall a. Read a => String -> Maybe a
safeRead (Result -> String
resultDescription Result
r) of
Maybe (WithLoHi Estimate)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just (WithLoHi Estimate
est Double
_ Double
_) -> forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef [(String, Estimate)]
ref ((String
name, Estimate
est) forall a. a -> [a] -> [a]
:)
svgRender :: [(TestName, Estimate)] -> String
svgRender :: [(String, Estimate)] -> String
svgRender [] = String
""
svgRender [(String, Estimate)]
pairs = String
header forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
(\Word64
i (String
name, Estimate
est) -> Word64 -> Word64 -> Double -> String -> Estimate -> String
svgRenderItem Word64
i Word64
l Double
xMax (forall a. [a] -> [a]
dropAllPrefix String
name) Estimate
est)
[Word64
0..]
[(String, Estimate)]
pairs) forall a. [a] -> [a] -> [a]
++ String
footer
where
dropAllPrefix :: [a] -> [a]
dropAllPrefix
| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((String
"All." forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(String, Estimate)]
pairs = forall a. Int -> [a] -> [a]
drop Int
4
| Bool
otherwise = forall a. a -> a
id
l :: Word64
l = forall i a. Num i => [a] -> i
genericLength [(String, Estimate)]
pairs
findMaxX :: Estimate -> Word64
findMaxX (Estimate Measurement
m Word64
stdev) = Measurement -> Word64
measTime Measurement
m forall a. Num a => a -> a -> a
+ Word64
2 forall a. Num a => a -> a -> a
* Word64
stdev
xMax :: Double
xMax = Word64 -> Double
word64ToDouble forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ forall a. Bounded a => a
minBound forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (Estimate -> Word64
findMaxX forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(String, Estimate)]
pairs
header :: String
header = forall r. PrintfType r => String -> r
printf String
"<svg xmlns=\"http://www.w3.org/2000/svg\" height=\"%i\" width=\"%f\" font-size=\"%i\" font-family=\"sans-serif\" stroke-width=\"2\">\n<g transform=\"translate(%f 0)\">\n" (Word64 -> Word64
svgItemOffset Word64
l forall a. Num a => a -> a -> a
- Word64
15) Double
svgCanvasWidth Word64
svgFontSize Double
svgCanvasMargin
footer :: String
footer = String
"</g>\n</svg>\n"
svgCanvasWidth :: Double
svgCanvasWidth :: Double
svgCanvasWidth = Double
960
svgCanvasMargin :: Double
svgCanvasMargin :: Double
svgCanvasMargin = Double
10
svgItemOffset :: Word64 -> Word64
svgItemOffset :: Word64 -> Word64
svgItemOffset Word64
i = Word64
22 forall a. Num a => a -> a -> a
+ Word64
55 forall a. Num a => a -> a -> a
* Word64
i
svgFontSize :: Word64
svgFontSize :: Word64
svgFontSize = Word64
16
svgRenderItem :: Word64 -> Word64 -> Double -> TestName -> Estimate -> String
svgRenderItem :: Word64 -> Word64 -> Double -> String -> Estimate -> String
svgRenderItem Word64
i Word64
iMax Double
xMax String
name est :: Estimate
est@(Estimate Measurement
m Word64
stdev) =
(if forall i a. Num i => [a] -> i
genericLength String
shortTextContent forall a. Num a => a -> a -> a
* Double
glyphWidth forall a. Ord a => a -> a -> Bool
< Double
boxWidth then String
longText else String
shortText) forall a. [a] -> [a] -> [a]
++ String
box
where
y :: Word64
y = Word64 -> Word64
svgItemOffset Word64
i
y' :: Word64
y' = Word64
y forall a. Num a => a -> a -> a
+ (Word64
svgFontSize forall a. Num a => a -> a -> a
* Word64
3) forall {a}. Integral a => a -> a -> a
`quot` Word64
8
y1 :: Word64
y1 = Word64
y' forall a. Num a => a -> a -> a
+ Word64
whiskerMargin
y2 :: Word64
y2 = Word64
y' forall a. Num a => a -> a -> a
+ Word64
boxHeight forall {a}. Integral a => a -> a -> a
`quot` Word64
2
y3 :: Word64
y3 = Word64
y' forall a. Num a => a -> a -> a
+ Word64
boxHeight forall a. Num a => a -> a -> a
- Word64
whiskerMargin
x1 :: Double
x1 = Double
boxWidth forall a. Num a => a -> a -> a
- Double
whiskerWidth
x2 :: Double
x2 = Double
boxWidth forall a. Num a => a -> a -> a
+ Double
whiskerWidth
deg :: Word64
deg = (Word64
i forall a. Num a => a -> a -> a
* Word64
360) forall {a}. Integral a => a -> a -> a
`quot` Word64
iMax
glyphWidth :: Double
glyphWidth = Word64 -> Double
word64ToDouble Word64
svgFontSize forall a. Fractional a => a -> a -> a
/ Double
2
scale :: Word64 -> Double
scale Word64
w = Word64 -> Double
word64ToDouble Word64
w forall a. Num a => a -> a -> a
* (Double
svgCanvasWidth forall a. Num a => a -> a -> a
- Double
2 forall a. Num a => a -> a -> a
* Double
svgCanvasMargin) forall a. Fractional a => a -> a -> a
/ Double
xMax
boxWidth :: Double
boxWidth = Word64 -> Double
scale (Measurement -> Word64
measTime Measurement
m)
whiskerWidth :: Double
whiskerWidth = Word64 -> Double
scale (Word64
2 forall a. Num a => a -> a -> a
* Word64
stdev)
boxHeight :: Word64
boxHeight = Word64
22
whiskerMargin :: Word64
whiskerMargin = Word64
5
box :: String
box = forall r. PrintfType r => String -> r
printf String
boxTemplate
(Estimate -> String
prettyEstimate Estimate
est)
Word64
y' Word64
boxHeight Double
boxWidth Word64
deg Word64
deg
Word64
deg
Double
x1 Double
x2 Word64
y2 Word64
y2
Double
x1 Double
x1 Word64
y1 Word64
y3
Double
x2 Double
x2 Word64
y1 Word64
y3
boxTemplate :: String
boxTemplate
= String
"<g>\n<title>%s</title>\n"
forall a. [a] -> [a] -> [a]
++ String
"<rect y=\"%i\" rx=\"5\" height=\"%i\" width=\"%f\" fill=\"hsl(%i, 100%%, 80%%)\" stroke=\"hsl(%i, 100%%, 55%%)\" />\n"
forall a. [a] -> [a] -> [a]
++ String
"<g stroke=\"hsl(%i, 100%%, 40%%)\">"
forall a. [a] -> [a] -> [a]
++ String
"<line x1=\"%f\" x2=\"%f\" y1=\"%i\" y2=\"%i\" />\n"
forall a. [a] -> [a] -> [a]
++ String
"<line x1=\"%f\" x2=\"%f\" y1=\"%i\" y2=\"%i\" />\n"
forall a. [a] -> [a] -> [a]
++ String
"<line x1=\"%f\" x2=\"%f\" y1=\"%i\" y2=\"%i\" />\n"
forall a. [a] -> [a] -> [a]
++ String
"</g>\n</g>\n"
longText :: String
longText = forall r. PrintfType r => String -> r
printf String
longTextTemplate
Word64
deg
Word64
y (ShowS
encodeSvg String
name)
Word64
y Double
boxWidth (Word64 -> String
showPicos4 (Measurement -> Word64
measTime Measurement
m))
longTextTemplate :: String
longTextTemplate
= String
"<g fill=\"hsl(%i, 100%%, 40%%)\">\n"
forall a. [a] -> [a] -> [a]
++ String
"<text y=\"%i\">%s</text>\n"
forall a. [a] -> [a] -> [a]
++ String
"<text y=\"%i\" x=\"%f\" text-anchor=\"end\">%s</text>\n"
forall a. [a] -> [a] -> [a]
++ String
"</g>\n"
shortTextContent :: String
shortTextContent = ShowS
encodeSvg String
name forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ Word64 -> String
showPicos4 (Measurement -> Word64
measTime Measurement
m)
shortText :: String
shortText = forall r. PrintfType r => String -> r
printf String
shortTextTemplate Word64
deg Word64
y String
shortTextContent
shortTextTemplate :: String
shortTextTemplate = String
"<text fill=\"hsl(%i, 100%%, 40%%)\" y=\"%i\">%s</text>\n"
encodeSvg :: String -> String
encodeSvg :: ShowS
encodeSvg [] = []
encodeSvg (Char
'<' : String
xs) = Char
'&' forall a. a -> [a] -> [a]
: Char
'l' forall a. a -> [a] -> [a]
: Char
't' forall a. a -> [a] -> [a]
: Char
';' forall a. a -> [a] -> [a]
: ShowS
encodeSvg String
xs
encodeSvg (Char
'&' : String
xs) = Char
'&' forall a. a -> [a] -> [a]
: Char
'a' forall a. a -> [a] -> [a]
: Char
'm' forall a. a -> [a] -> [a]
: Char
'p' forall a. a -> [a] -> [a]
: Char
';' forall a. a -> [a] -> [a]
: ShowS
encodeSvg String
xs
encodeSvg (Char
x : String
xs) = Char
x forall a. a -> [a] -> [a]
: ShowS
encodeSvg String
xs
newtype BaselinePath = BaselinePath FilePath
deriving (Typeable)
instance IsOption (Maybe BaselinePath) where
defaultValue :: Maybe BaselinePath
defaultValue = forall a. Maybe a
Nothing
parseValue :: String -> Maybe (Maybe BaselinePath)
parseValue = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> BaselinePath
BaselinePath
optionName :: Tagged (Maybe BaselinePath) String
optionName = forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"baseline"
optionHelp :: Tagged (Maybe BaselinePath) String
optionHelp = forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"File with baseline results in CSV format to compare against"
consoleBenchReporter :: Ingredient
consoleBenchReporter :: Ingredient
consoleBenchReporter = [OptionDescription]
-> (OptionSet
-> IO (String -> Maybe (WithLoHi Result) -> Result -> Result))
-> Ingredient
modifyConsoleReporter [forall v. IsOption v => Proxy v -> OptionDescription
Option (forall {k} (t :: k). Proxy t
Proxy :: Proxy (Maybe BaselinePath))] forall a b. (a -> b) -> a -> b
$ \OptionSet
opts -> do
Set String
baseline <- case forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
opts of
Maybe BaselinePath
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Set a
S.empty
Just (BaselinePath String
path) -> forall a. Ord a => [a] -> Set a
S.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
joinQuotedFields forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> IO String
readFile String
path forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. a -> IO a
evaluate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NFData a => a -> a
force)
let pretty :: Estimate -> String
pretty = if Bool
hasGCStats then Estimate -> String
prettyEstimateWithGC else Estimate -> String
prettyEstimate
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ \String
name Maybe (WithLoHi Result)
mDepR Result
r -> case forall a. Read a => String -> Maybe a
safeRead (Result -> String
resultDescription Result
r) of
Maybe (WithLoHi Estimate)
Nothing -> Result
r
Just (WithLoHi Estimate
est Double
lowerBound Double
upperBound) ->
(if Bool
isAcceptable then forall a. a -> a
id else Result -> Result
forceFail)
Result
r { resultDescription :: String
resultDescription = Estimate -> String
pretty Estimate
est forall a. [a] -> [a] -> [a]
++ String
bcompareMsg forall a. [a] -> [a] -> [a]
++ Maybe Double -> String
formatSlowDown Maybe Double
mSlowDown }
where
isAcceptable :: Bool
isAcceptable = Bool
isAcceptableVsBaseline Bool -> Bool -> Bool
&& Bool
isAcceptableVsBcompare
mSlowDown :: Maybe Double
mSlowDown = Set String -> String -> Estimate -> Maybe Double
compareVsBaseline Set String
baseline String
name Estimate
est
slowDown :: Double
slowDown = forall a. a -> Maybe a -> a
fromMaybe Double
1 Maybe Double
mSlowDown
isAcceptableVsBaseline :: Bool
isAcceptableVsBaseline = Double
slowDown forall a. Ord a => a -> a -> Bool
>= Double
lowerBound Bool -> Bool -> Bool
&& Double
slowDown forall a. Ord a => a -> a -> Bool
<= Double
upperBound
(Bool
isAcceptableVsBcompare, String
bcompareMsg) = case Maybe (WithLoHi Result)
mDepR of
Maybe (WithLoHi Result)
Nothing -> (Bool
True, String
"")
Just (WithLoHi Result
depR Double
depLowerBound Double
depUpperBound) -> case forall a. Read a => String -> Maybe a
safeRead (Result -> String
resultDescription Result
depR) of
Maybe (WithLoHi Estimate)
Nothing -> (Bool
True, String
"")
Just (WithLoHi Estimate
depEst Double
_ Double
_) -> let ratio :: Double
ratio = Estimate -> Double
estTime Estimate
est forall a. Fractional a => a -> a -> a
/ Estimate -> Double
estTime Estimate
depEst in
( Double
ratio forall a. Ord a => a -> a -> Bool
>= Double
depLowerBound Bool -> Bool -> Bool
&& Double
ratio forall a. Ord a => a -> a -> Bool
<= Double
depUpperBound
, forall r. PrintfType r => String -> r
printf String
", %.2fx" Double
ratio
)
joinQuotedFields :: [String] -> [String]
joinQuotedFields :: [String] -> [String]
joinQuotedFields [] = []
joinQuotedFields (String
x : [String]
xs)
| String -> Bool
areQuotesBalanced String
x = String
x forall a. a -> [a] -> [a]
: [String] -> [String]
joinQuotedFields [String]
xs
| Bool
otherwise = case forall a. (a -> Bool) -> [a] -> ([a], [a])
span String -> Bool
areQuotesBalanced [String]
xs of
([String]
_, []) -> []
([String]
ys, String
z : [String]
zs) -> [String] -> String
unlines (String
x forall a. a -> [a] -> [a]
: [String]
ys forall a. [a] -> [a] -> [a]
++ [String
z]) forall a. a -> [a] -> [a]
: [String] -> [String]
joinQuotedFields [String]
zs
where
areQuotesBalanced :: String -> Bool
areQuotesBalanced = forall a. Integral a => a -> Bool
even forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
== Char
'"')
estTime :: Estimate -> Double
estTime :: Estimate -> Double
estTime = Word64 -> Double
word64ToDouble forall b c a. (b -> c) -> (a -> b) -> a -> c
. Measurement -> Word64
measTime forall b c a. (b -> c) -> (a -> b) -> a -> c
. Estimate -> Measurement
estMean
compareVsBaseline :: S.Set String -> TestName -> Estimate -> Maybe Double
compareVsBaseline :: Set String -> String -> Estimate -> Maybe Double
compareVsBaseline Set String
baseline String
name (Estimate Measurement
m Word64
stdev) = case Maybe (Int64, Int64)
mOld of
Maybe (Int64, Int64)
Nothing -> forall a. Maybe a
Nothing
Just (Int64
oldTime, Int64
oldDoubleSigma)
| forall {a}. Num a => a -> a
abs (Int64
time forall a. Num a => a -> a -> a
- Int64
oldTime) forall a. Ord a => a -> a -> Bool
< forall a. Ord a => a -> a -> a
max (Int64
2 forall a. Num a => a -> a -> a
* Word64 -> Int64
word64ToInt64 Word64
stdev) Int64
oldDoubleSigma -> forall a. a -> Maybe a
Just Double
1
| Bool
otherwise -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Int64 -> Double
int64ToDouble Int64
time forall a. Fractional a => a -> a -> a
/ Int64 -> Double
int64ToDouble Int64
oldTime
where
time :: Int64
time = Word64 -> Int64
word64ToInt64 forall a b. (a -> b) -> a -> b
$ Measurement -> Word64
measTime Measurement
m
mOld :: Maybe (Int64, Int64)
mOld :: Maybe (Int64, Int64)
mOld = do
let prefix :: String
prefix = ShowS
encodeCsv String
name forall a. [a] -> [a] -> [a]
++ String
","
(String
line, Set String
furtherLines) <- forall a. Set a -> Maybe (a, Set a)
S.minView forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> Set a -> (Set a, Set a)
S.split String
prefix Set String
baseline
case forall a. Set a -> Maybe (a, Set a)
S.minView Set String
furtherLines of
Maybe (String, Set String)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just (String
nextLine, Set String
_) -> case forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
prefix String
nextLine of
Maybe String
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just{} -> forall a. Maybe a
Nothing
(String
timeCell, Char
',' : String
rest) <- forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall a. Eq a => a -> a -> Bool
/= Char
',') forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
prefix String
line
let doubleSigmaCell :: String
doubleSigmaCell = forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
',') String
rest
(,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Read a => String -> Maybe a
safeRead String
timeCell forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Read a => String -> Maybe a
safeRead String
doubleSigmaCell
formatSlowDown :: Maybe Double -> String
formatSlowDown :: Maybe Double -> String
formatSlowDown Maybe Double
Nothing = String
""
formatSlowDown (Just Double
ratio) = case Int64
percents forall a. Ord a => a -> a -> Ordering
`compare` Int64
0 of
Ordering
LT -> forall r. PrintfType r => String -> r
printf String
", %2i%% less than baseline" (-Int64
percents)
Ordering
EQ -> String
", same as baseline"
Ordering
GT -> forall r. PrintfType r => String -> r
printf String
", %2i%% more than baseline" Int64
percents
where
percents :: Int64
percents :: Int64
percents = forall a b. (RealFrac a, Integral b) => a -> b
truncate ((Double
ratio forall a. Num a => a -> a -> a
- Double
1) forall a. Num a => a -> a -> a
* Double
100)
forceFail :: Result -> Result
forceFail :: Result -> Result
forceFail Result
r = Result
r { resultOutcome :: Outcome
resultOutcome = FailureReason -> Outcome
Failure FailureReason
TestFailed, resultShortDescription :: String
resultShortDescription = String
"FAIL" }
data Unique a = None | Unique !a | NotUnique
deriving (forall a b. a -> Unique b -> Unique a
forall a b. (a -> b) -> Unique a -> Unique b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Unique b -> Unique a
$c<$ :: forall a b. a -> Unique b -> Unique a
fmap :: forall a b. (a -> b) -> Unique a -> Unique b
$cfmap :: forall a b. (a -> b) -> Unique a -> Unique b
Functor)
appendUnique :: Unique a -> Unique a -> Unique a
appendUnique :: forall a. Unique a -> Unique a -> Unique a
appendUnique Unique a
None Unique a
a = Unique a
a
appendUnique Unique a
a Unique a
None = Unique a
a
appendUnique Unique a
_ Unique a
_ = forall a. Unique a
NotUnique
#if MIN_VERSION_base(4,9,0)
instance Semigroup (Unique a) where
<> :: Unique a -> Unique a -> Unique a
(<>) = forall a. Unique a -> Unique a -> Unique a
appendUnique
#endif
instance Monoid (Unique a) where
mempty :: Unique a
mempty = forall a. Unique a
None
#if MIN_VERSION_base(4,9,0)
mappend :: Unique a -> Unique a -> Unique a
mappend = forall a. Semigroup a => a -> a -> a
(<>)
#else
mappend = appendUnique
#endif
modifyConsoleReporter
:: [OptionDescription]
-> (OptionSet -> IO (TestName -> Maybe (WithLoHi Result) -> Result -> Result))
-> Ingredient
modifyConsoleReporter :: [OptionDescription]
-> (OptionSet
-> IO (String -> Maybe (WithLoHi Result) -> Result -> Result))
-> Ingredient
modifyConsoleReporter [OptionDescription]
desc' OptionSet
-> IO (String -> Maybe (WithLoHi Result) -> Result -> Result)
iof = [OptionDescription]
-> (OptionSet
-> Benchmark -> Maybe (StatusMap -> IO (Double -> IO Bool)))
-> Ingredient
TestReporter ([OptionDescription]
desc forall a. [a] -> [a] -> [a]
++ [OptionDescription]
desc') forall a b. (a -> b) -> a -> b
$ \OptionSet
opts Benchmark
tree ->
let nameSeqs :: IntMap (Seq String)
nameSeqs = forall a. [(Int, a)] -> IntMap a
IM.fromDistinctAscList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] forall a b. (a -> b) -> a -> b
$ OptionSet -> Benchmark -> [Seq String]
testNameSeqs OptionSet
opts Benchmark
tree
namesAndDeps :: IntMap (String, Maybe (WithLoHi Int))
namesAndDeps = forall a. [(Int, a)] -> IntMap a
IM.fromDistinctAscList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall {a}. Unique a -> Maybe a
isSingle)
forall a b. (a -> b) -> a -> b
$ IntMap (Seq String)
-> OptionSet -> Benchmark -> [(String, Unique (WithLoHi Int))]
testNamesAndDeps IntMap (Seq String)
nameSeqs OptionSet
opts Benchmark
tree
modifySMap :: StatusMap -> IO StatusMap
modifySMap = (OptionSet
-> IO (String -> Maybe (WithLoHi Result) -> Result -> Result)
iof OptionSet
opts forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip (String -> Maybe (WithLoHi Result) -> Result -> Result)
-> IntMap (String, Maybe (WithLoHi Int), TVar Status)
-> IO StatusMap
postprocessResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
IM.intersectionWith (\(String
a, Maybe (WithLoHi Int)
b) TVar Status
c -> (String
a, Maybe (WithLoHi Int)
b, TVar Status
c)) IntMap (String, Maybe (WithLoHi Int))
namesAndDeps
in (StatusMap -> IO StatusMap
modifySMap forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OptionSet
-> Benchmark -> Maybe (StatusMap -> IO (Double -> IO Bool))
cb OptionSet
opts Benchmark
tree
where
([OptionDescription]
desc, OptionSet
-> Benchmark -> Maybe (StatusMap -> IO (Double -> IO Bool))
cb) = case Ingredient
consoleTestReporter of
TestReporter [OptionDescription]
d OptionSet
-> Benchmark -> Maybe (StatusMap -> IO (Double -> IO Bool))
c -> ([OptionDescription]
d, OptionSet
-> Benchmark -> Maybe (StatusMap -> IO (Double -> IO Bool))
c)
Ingredient
_ -> forall a. HasCallStack => String -> a
error String
"modifyConsoleReporter: consoleTestReporter must be TestReporter"
isSingle :: Unique a -> Maybe a
isSingle (Unique a
a) = forall a. a -> Maybe a
Just a
a
isSingle Unique a
_ = forall a. Maybe a
Nothing
testNameSeqs :: OptionSet -> TestTree -> [Seq TestName]
testNameSeqs :: OptionSet -> Benchmark -> [Seq String]
testNameSeqs = forall b. Monoid b => TreeFold b -> OptionSet -> Benchmark -> b
foldTestTree forall b. Monoid b => TreeFold b
trivialFold
{ foldSingle :: forall t. IsTest t => OptionSet -> String -> t -> [Seq String]
foldSingle = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Seq a
Seq.singleton
#if MIN_VERSION_tasty(1,4,0)
, foldGroup :: OptionSet -> String -> [Seq String] -> [Seq String]
foldGroup = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Seq a -> Seq a
(<|)
#else
, foldGroup = map . (<|)
#endif
}
testNamesAndDeps :: IntMap (Seq TestName) -> OptionSet -> TestTree -> [(TestName, Unique (WithLoHi IM.Key))]
testNamesAndDeps :: IntMap (Seq String)
-> OptionSet -> Benchmark -> [(String, Unique (WithLoHi Int))]
testNamesAndDeps IntMap (Seq String)
im = forall b. Monoid b => TreeFold b -> OptionSet -> Benchmark -> b
foldTestTree forall b. Monoid b => TreeFold b
trivialFold
{ foldSingle :: forall t.
IsTest t =>
OptionSet -> String -> t -> [(String, Unique (WithLoHi Int))]
foldSingle = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
: []) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (, forall a. Monoid a => a
mempty)
#if MIN_VERSION_tasty(1,4,0)
, foldGroup :: OptionSet
-> String
-> [(String, Unique (WithLoHi Int))]
-> [(String, Unique (WithLoHi Int))]
foldGroup = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a] -> [a]
(++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. [a] -> [a] -> [a]
++ String
".")
, foldAfter :: OptionSet
-> DependencyType
-> Expr
-> [(String, Unique (WithLoHi Int))]
-> [(String, Unique (WithLoHi Int))]
foldAfter = forall a b. a -> b -> a
const forall a.
DependencyType
-> Expr
-> [(a, Unique (WithLoHi Int))]
-> [(a, Unique (WithLoHi Int))]
foldDeps
#else
, foldGroup = map . first . (++) . (++ ".")
, foldAfter = foldDeps
#endif
}
where
foldDeps :: DependencyType -> Expr -> [(a, Unique (WithLoHi IM.Key))] -> [(a, Unique (WithLoHi IM.Key))]
foldDeps :: forall a.
DependencyType
-> Expr
-> [(a, Unique (WithLoHi Int))]
-> [(a, Unique (WithLoHi Int))]
foldDeps DependencyType
AllSucceed (And (StringLit String
xs) Expr
p)
| String
bcomparePrefix forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
xs
, Just (Double
lo :: Double, Double
hi :: Double) <- forall a. Read a => String -> Maybe a
safeRead forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
bcomparePrefix) String
xs
= forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a -> a -> a
mappend forall a b. (a -> b) -> a -> b
$ (\Int
x -> forall a. a -> Double -> Double -> WithLoHi a
WithLoHi Int
x Double
lo Double
hi) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IntMap (Seq String) -> Expr -> Unique Int
findMatchingKeys IntMap (Seq String)
im Expr
p
foldDeps DependencyType
_ Expr
_ = forall a. a -> a
id
findMatchingKeys :: IntMap (Seq TestName) -> Expr -> Unique IM.Key
findMatchingKeys :: IntMap (Seq String) -> Expr -> Unique Int
findMatchingKeys IntMap (Seq String)
im Expr
pattern =
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\(Int
k, Seq String
v) -> if forall a. Seq String -> M a -> Either String a
withFields Seq String
v ReaderT (Seq String) (Either String) Bool
pat forall a. Eq a => a -> a -> Bool
== forall a b. b -> Either a b
Right Bool
True then forall a. a -> Unique a
Unique Int
k else forall a. Monoid a => a
mempty) forall a b. (a -> b) -> a -> b
$ forall a. IntMap a -> [(Int, a)]
IM.assocs IntMap (Seq String)
im
where
pat :: ReaderT (Seq String) (Either String) Bool
pat = Expr -> M Value
eval Expr
pattern forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> ReaderT (Seq String) (Either String) Bool
asB
postprocessResult
:: (TestName -> Maybe (WithLoHi Result) -> Result -> Result)
-> IntMap (TestName, Maybe (WithLoHi IM.Key), TVar Status)
-> IO StatusMap
postprocessResult :: (String -> Maybe (WithLoHi Result) -> Result -> Result)
-> IntMap (String, Maybe (WithLoHi Int), TVar Status)
-> IO StatusMap
postprocessResult String -> Maybe (WithLoHi Result) -> Result -> Result
f IntMap (String, Maybe (WithLoHi Int), TVar Status)
src = do
IntMap (String, Maybe (WithLoHi Int), TVar Status, TVar Status)
paired <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM IntMap (String, Maybe (WithLoHi Int), TVar Status)
src forall a b. (a -> b) -> a -> b
$ \(String
name, Maybe (WithLoHi Int)
mDepId, TVar Status
tv) -> (String
name, Maybe (WithLoHi Int)
mDepId, TVar Status
tv,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> IO (TVar a)
newTVarIO Status
NotStarted
let doUpdate :: IO Bool
doUpdate = forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ do
(Any Bool
anyUpdated, All Bool
allDone) <-
forall (f :: * -> *) a. Ap f a -> f a
getApp forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap IntMap (String, Maybe (WithLoHi Int), TVar Status, TVar Status)
paired forall a b. (a -> b) -> a -> b
$ \(String
name, Maybe (WithLoHi Int)
mDepId, TVar Status
newTV, TVar Status
oldTV) -> forall (f :: * -> *) a. f a -> Ap f a
Ap forall a b. (a -> b) -> a -> b
$ do
Status
old <- forall a. TVar a -> STM a
readTVar TVar Status
oldTV
case Status
old of
Done{} -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Any
Any Bool
False, Bool -> All
All Bool
True)
Status
_ -> do
Status
new <- forall a. TVar a -> STM a
readTVar TVar Status
newTV
case Status
new of
Done Result
res -> do
Maybe (WithLoHi Result)
depRes <- case Maybe (WithLoHi Int)
mDepId of
Maybe (WithLoHi Int)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
Just (WithLoHi Int
depId Double
lo Double
hi) -> case forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
depId IntMap (String, Maybe (WithLoHi Int), TVar Status)
src of
Maybe (String, Maybe (WithLoHi Int), TVar Status)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
Just (String
_, Maybe (WithLoHi Int)
_, TVar Status
depTV) -> do
Status
depStatus <- forall a. TVar a -> STM a
readTVar TVar Status
depTV
case Status
depStatus of
Done Result
dep -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (forall a. a -> Double -> Double -> WithLoHi a
WithLoHi Result
dep Double
lo Double
hi)
Status
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
forall a. TVar a -> a -> STM ()
writeTVar TVar Status
oldTV (Result -> Status
Done (String -> Maybe (WithLoHi Result) -> Result -> Result
f String
name Maybe (WithLoHi Result)
depRes Result
res))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Any
Any Bool
True, Bool -> All
All Bool
True)
Status
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Any
Any Bool
False, Bool -> All
All Bool
False)
if Bool
anyUpdated Bool -> Bool -> Bool
|| Bool
allDone then forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
allDone else forall a. STM a
retry
adNauseam :: IO ()
adNauseam = IO Bool
doUpdate forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
`unless` IO ()
adNauseam)
ThreadId
_ <- IO () -> IO ThreadId
forkIO IO ()
adNauseam
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(String
_, Maybe (WithLoHi Int)
_, TVar Status
_, TVar Status
a) -> TVar Status
a) IntMap (String, Maybe (WithLoHi Int), TVar Status, TVar Status)
paired
int64ToDouble :: Int64 -> Double
int64ToDouble :: Int64 -> Double
int64ToDouble = forall a b. (Integral a, Num b) => a -> b
fromIntegral
word64ToInt64 :: Word64 -> Int64
word64ToInt64 :: Word64 -> Int64
word64ToInt64 = forall a b. (Integral a, Num b) => a -> b
fromIntegral
#endif
word64ToDouble :: Word64 -> Double
word64ToDouble :: Word64 -> Double
word64ToDouble = forall a b. (Integral a, Num b) => a -> b
fromIntegral
#if !MIN_VERSION_base(4,10,0) && MIN_VERSION_base(4,6,0)
int64ToWord64 :: Int64 -> Word64
int64ToWord64 = fromIntegral
#endif
#if defined(mingw32_HOST_OS)
#if defined(i386_HOST_ARCH)
#define CCONV stdcall
#else
#define CCONV ccall
#endif
foreign import CCONV unsafe "windows.h GetConsoleOutputCP" getConsoleOutputCP :: IO Word32
foreign import CCONV unsafe "windows.h SetConsoleOutputCP" setConsoleOutputCP :: Word32 -> IO ()
#endif
#ifdef MIN_VERSION_tasty
mapLeafBenchmarks :: ([String] -> Benchmark -> Benchmark) -> Benchmark -> Benchmark
mapLeafBenchmarks :: ([String] -> Benchmark -> Benchmark) -> Benchmark -> Benchmark
mapLeafBenchmarks [String] -> Benchmark -> Benchmark
processLeaf = [String] -> Benchmark -> Benchmark
go forall a. Monoid a => a
mempty
where
go :: [String] -> Benchmark -> Benchmark
go :: [String] -> Benchmark -> Benchmark
go [String]
path Benchmark
x = case Benchmark
x of
SingleTest String
name t
t -> [String] -> Benchmark -> Benchmark
processLeaf (String
name forall a. a -> [a] -> [a]
: [String]
path) (forall t. IsTest t => String -> t -> Benchmark
SingleTest String
name t
t)
TestGroup String
name [Benchmark]
tts -> String -> [Benchmark] -> Benchmark
TestGroup String
name (forall a b. (a -> b) -> [a] -> [b]
map ([String] -> Benchmark -> Benchmark
go (String
name forall a. a -> [a] -> [a]
: [String]
path)) [Benchmark]
tts)
PlusTestOptions OptionSet -> OptionSet
g Benchmark
tt -> (OptionSet -> OptionSet) -> Benchmark -> Benchmark
PlusTestOptions OptionSet -> OptionSet
g ([String] -> Benchmark -> Benchmark
go [String]
path Benchmark
tt)
WithResource ResourceSpec a
res IO a -> Benchmark
f -> forall a. ResourceSpec a -> (IO a -> Benchmark) -> Benchmark
WithResource ResourceSpec a
res ([String] -> Benchmark -> Benchmark
go [String]
path forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> Benchmark
f)
AskOptions OptionSet -> Benchmark
f -> (OptionSet -> Benchmark) -> Benchmark
AskOptions ([String] -> Benchmark -> Benchmark
go [String]
path forall b c a. (b -> c) -> (a -> b) -> a -> c
. OptionSet -> Benchmark
f)
After DependencyType
dep Expr
expr Benchmark
tt -> DependencyType -> Expr -> Benchmark -> Benchmark
After DependencyType
dep Expr
expr ([String] -> Benchmark -> Benchmark
go [String]
path Benchmark
tt)
locateBenchmark :: [String] -> Expr
locateBenchmark :: [String] -> Expr
locateBenchmark [] = Int -> Expr
IntLit Int
1
locateBenchmark [String]
path
= forall a. (a -> a -> a) -> [a] -> a
foldl1' Expr -> Expr -> Expr
And
forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
i String
name -> Expr -> Expr -> Expr
Patterns.EQ (Expr -> Expr
Field (Expr -> Expr -> Expr
Sub Expr
NF (Int -> Expr
IntLit Int
i))) (String -> Expr
StringLit String
name)) [Int
0..] [String]
path
#endif