{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
module Test.Tasty.Bench
(
defaultMain
, Benchmark
, bench
, bgroup
#if MIN_VERSION_tasty(1,2,0)
, bcompare
#endif
, env
, envWithCleanup
, Benchmarkable(..)
, nf
, whnf
, nfIO
, whnfIO
, nfAppIO
, whnfAppIO
, measureCpuTime
, benchIngredients
, consoleBenchReporter
, csvReporter
, svgReporter
, RelStDev(..)
, FailIfSlower(..)
, FailIfFaster(..)
, CsvPath(..)
, BaselinePath(..)
, SvgPath(..)
) where
import Prelude hiding (Int, Integer)
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.IntMap (IntMap)
#if MIN_VERSION_containers(0,5,0)
import qualified Data.IntMap.Strict as IM
#else
import qualified Data.IntMap as IM
#endif
import Data.IORef
import Data.List (intercalate, stripPrefix, isPrefixOf, genericLength, genericDrop)
import Data.Monoid (All(..), Any(..))
import Data.Proxy
import Data.Sequence (Seq, (<|))
import qualified Data.Sequence as Seq
import qualified Data.Set as S
import Data.Traversable (forM)
import Data.Word (Word64)
import GHC.Conc
#if MIN_VERSION_base(4,6,0)
import GHC.Stats
#endif
import System.CPUTime
import System.Mem
import Test.Tasty hiding (defaultMain)
import qualified Test.Tasty
import Test.Tasty.Ingredients
import Test.Tasty.Ingredients.ConsoleReporter
import Test.Tasty.Options
#if MIN_VERSION_tasty(1,2,0)
import Test.Tasty.Patterns.Eval (eval, asB, withFields)
import Test.Tasty.Patterns.Types (Expr (And, StringLit))
#endif
import Test.Tasty.Providers
import Test.Tasty.Runners
import Text.Printf
import System.Exit
import System.IO
import System.IO.Unsafe
newtype RelStDev = RelStDev Double
deriving (Int -> RelStDev -> ShowS
[RelStDev] -> ShowS
RelStDev -> String
(Int -> RelStDev -> ShowS)
-> (RelStDev -> String) -> ([RelStDev] -> ShowS) -> Show RelStDev
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]
(Int -> ReadS RelStDev)
-> ReadS [RelStDev]
-> ReadPrec RelStDev
-> ReadPrec [RelStDev]
-> Read 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)
instance IsOption RelStDev where
defaultValue :: RelStDev
defaultValue = Double -> RelStDev
RelStDev Double
0.05
parseValue :: String -> Maybe RelStDev
parseValue = (Double -> RelStDev) -> Maybe Double -> Maybe RelStDev
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> RelStDev
RelStDev (Maybe Double -> Maybe RelStDev)
-> (String -> Maybe Double) -> String -> Maybe RelStDev
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Double
parsePositivePercents
optionName :: Tagged RelStDev String
optionName = String -> Tagged RelStDev String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"stdev"
optionHelp :: Tagged RelStDev String
optionHelp = String -> Tagged RelStDev String
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
(Int -> FailIfSlower -> ShowS)
-> (FailIfSlower -> String)
-> ([FailIfSlower] -> ShowS)
-> Show FailIfSlower
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]
(Int -> ReadS FailIfSlower)
-> ReadS [FailIfSlower]
-> ReadPrec FailIfSlower
-> ReadPrec [FailIfSlower]
-> Read 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 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
0.0)
parseValue :: String -> Maybe FailIfSlower
parseValue = (Double -> FailIfSlower) -> Maybe Double -> Maybe FailIfSlower
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> FailIfSlower
FailIfSlower (Maybe Double -> Maybe FailIfSlower)
-> (String -> Maybe Double) -> String -> Maybe FailIfSlower
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Double
parsePositivePercents
optionName :: Tagged FailIfSlower String
optionName = String -> Tagged FailIfSlower String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"fail-if-slower"
optionHelp :: Tagged FailIfSlower String
optionHelp = String -> Tagged FailIfSlower String
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
(Int -> FailIfFaster -> ShowS)
-> (FailIfFaster -> String)
-> ([FailIfFaster] -> ShowS)
-> Show FailIfFaster
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]
(Int -> ReadS FailIfFaster)
-> ReadS [FailIfFaster]
-> ReadPrec FailIfFaster
-> ReadPrec [FailIfFaster]
-> Read 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 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
0.0)
parseValue :: String -> Maybe FailIfFaster
parseValue = (Double -> FailIfFaster) -> Maybe Double -> Maybe FailIfFaster
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> FailIfFaster
FailIfFaster (Maybe Double -> Maybe FailIfFaster)
-> (String -> Maybe Double) -> String -> Maybe FailIfFaster
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Double
parsePositivePercents
optionName :: Tagged FailIfFaster String
optionName = String -> Tagged FailIfFaster String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"fail-if-faster"
optionHelp :: Tagged FailIfFaster String
optionHelp = String -> Tagged FailIfFaster String
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 <- String -> Maybe Double
forall a. Read a => String -> Maybe a
safeRead String
xs
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0)
Double -> Maybe Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double
x Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
100)
newtype Benchmarkable = Benchmarkable
{ Benchmarkable -> Word64 -> IO ()
unBenchmarkable :: Word64 -> IO ()
} deriving (Typeable)
showPicos3 :: Word64 -> String
showPicos3 :: Word64 -> String
showPicos3 Word64
i
| Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
995 = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%3.0f ps" Double
t
| Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
995e1 = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%3.1f ns" (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1e3)
| Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
995e3 = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%3.0f ns" (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1e3)
| Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
995e4 = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%3.1f μs" (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1e6)
| Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
995e6 = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%3.0f μs" (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1e6)
| Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
995e7 = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%3.1f ms" (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1e9)
| Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
995e9 = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%3.0f ms" (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1e9)
| Bool
otherwise = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%4.2f s" (Double
t Double -> Double -> Double
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 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
995 = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%3.0f ps" Double
t
| Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
995e1 = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%4.2f ns" (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1e3)
| Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
995e2 = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%4.1f ns" (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1e3)
| Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
995e3 = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%3.0f ns" (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1e3)
| Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
995e4 = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%4.2f μs" (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1e6)
| Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
995e5 = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%4.1f μs" (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1e6)
| Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
995e6 = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%3.0f μs" (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1e6)
| Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
995e7 = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%4.2f ms" (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1e9)
| Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
995e8 = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%4.1f ms" (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1e9)
| Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
995e9 = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%3.0f ms" (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1e9)
| Bool
otherwise = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%4.3f s" (Double
t Double -> Double -> Double
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 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1000 = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%3.0f B " Double
t
| Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
10189 = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%3.1f KB" (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1024)
| Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1023488 = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%3.0f KB" (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1024)
| Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
10433332 = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%3.1f MB" (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1048576)
| Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1048051712 = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%3.0f MB" (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1048576)
| Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
10683731149 = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%3.1f GB" (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1073741824)
| Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1073204953088 = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%3.0f GB" (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1073741824)
| Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
10940140696372 = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%3.1f TB" (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1099511627776)
| Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1098961871962112 = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%3.0f TB" (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1099511627776)
| Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
11202704073084108 = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%3.1f PB" (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1125899906842624)
| Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1125336956889202624 = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%3.0f PB" (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1125899906842624)
| Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
11471568970838126592 = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%3.1f EB" (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1152921504606846976)
| Bool
otherwise = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%3.0f EB" (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1152921504606846976)
where
t :: Double
t = Word64 -> Double
word64ToDouble Word64
i
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
(Int -> Measurement -> ShowS)
-> (Measurement -> String)
-> ([Measurement] -> ShowS)
-> Show Measurement
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]
(Int -> ReadS Measurement)
-> ReadS [Measurement]
-> ReadPrec Measurement
-> ReadPrec [Measurement]
-> Read 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
(Int -> Estimate -> ShowS)
-> (Estimate -> String) -> ([Estimate] -> ShowS) -> Show Estimate
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]
(Int -> ReadS Estimate)
-> ReadS [Estimate]
-> ReadPrec Estimate
-> ReadPrec [Estimate]
-> Read 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)
data Response = Response
{ Response -> Estimate
respEstimate :: !Estimate
, Response -> FailIfSlower
respIfSlower :: !FailIfSlower
, Response -> FailIfFaster
respIfFaster :: !FailIfFaster
} deriving (Int -> Response -> ShowS
[Response] -> ShowS
Response -> String
(Int -> Response -> ShowS)
-> (Response -> String) -> ([Response] -> ShowS) -> Show Response
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Response] -> ShowS
$cshowList :: [Response] -> ShowS
show :: Response -> String
$cshow :: Response -> String
showsPrec :: Int -> Response -> ShowS
$cshowsPrec :: Int -> Response -> ShowS
Show, ReadPrec [Response]
ReadPrec Response
Int -> ReadS Response
ReadS [Response]
(Int -> ReadS Response)
-> ReadS [Response]
-> ReadPrec Response
-> ReadPrec [Response]
-> Read Response
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Response]
$creadListPrec :: ReadPrec [Response]
readPrec :: ReadPrec Response
$creadPrec :: ReadPrec Response
readList :: ReadS [Response]
$creadList :: ReadS [Response]
readsPrec :: Int -> ReadS Response
$creadsPrec :: Int -> ReadS Response
Read)
prettyEstimate :: Estimate -> String
prettyEstimate :: Estimate -> String
prettyEstimate (Estimate Measurement
m Word64
stdev) =
Word64 -> String
showPicos4 (Measurement -> Word64
measTime Measurement
m)
String -> ShowS
forall a. [a] -> [a] -> [a]
++ (if Word64
stdev Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 then String
" " else String
" ± " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> String
showPicos3 (Word64
2 Word64 -> Word64 -> Word64
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)
String -> ShowS
forall a. [a] -> [a] -> [a]
++ (if Word64
stdev Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 then String
", " else String
" ± " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> String
showPicos3 (Word64
2 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
stdev) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", ")
String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> String
showBytes (Measurement -> Word64
measAllocs Measurement
m) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" allocated, "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> String
showBytes (Measurement -> Word64
measCopied Measurement
m) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" copied, "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> String
showBytes (Measurement -> Word64
measMaxMem Measurement
m) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" peak memory"
csvEstimate :: Estimate -> String
csvEstimate :: Estimate -> String
csvEstimate (Estimate Measurement
m Word64
stdev) = Word64 -> String
forall a. Show a => a -> String
show (Measurement -> Word64
measTime Measurement
m) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"," String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. Show a => a -> String
show (Word64
2 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
stdev)
csvEstimateWithGC :: Estimate -> String
csvEstimateWithGC :: Estimate -> String
csvEstimateWithGC (Estimate Measurement
m Word64
stdev) = Word64 -> String
forall a. Show a => a -> String
show (Measurement -> Word64
measTime Measurement
m) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"," String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. Show a => a -> String
show (Word64
2 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
stdev)
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"," String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. Show a => a -> String
show (Measurement -> Word64
measAllocs Measurement
m) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"," String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. Show a => a -> String
show (Measurement -> Word64
measCopied Measurement
m) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"," String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. Show a => a -> String
show (Measurement -> Word64
measMaxMem Measurement
m)
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 :: Measurement -> Word64 -> Estimate
Estimate
{ estMean :: Measurement
estMean = Word64 -> Word64 -> Word64 -> Word64 -> Measurement
Measurement Word64
t (Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
fit Word64
a1 Word64
a2) (Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
fit Word64
c1 Word64
c2) (Word64 -> Word64 -> Word64
forall a. Ord a => a -> a -> a
max Word64
m1 Word64
m2)
, estStdev :: Word64
estStdev = Double -> Word64
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Double -> Double
forall a. Floating a => a -> a
sqrt Double
d :: Double)
}
where
fit :: a -> a -> a
fit a
x1 a
x2 = a
x1 a -> a -> a
forall a. Integral a => a -> a -> a
`quot` a
5 a -> a -> a
forall a. Num a => a -> a -> a
+ a
2 a -> a -> a
forall a. Num a => a -> a -> a
* (a
x2 a -> a -> a
forall a. Integral a => a -> a -> a
`quot` a
5)
t :: Word64
t = Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
fit Word64
t1 Word64
t2
sqr :: a -> a
sqr a
x = a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
x
d :: Double
d = Double -> Double
forall a. Num a => a -> a
sqr (Word64 -> Double
word64ToDouble Word64
t1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Word64 -> Double
word64ToDouble Word64
t)
Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double -> Double
forall a. Num a => a -> a
sqr (Word64 -> Double
word64ToDouble Word64
t2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
2 Double -> Double -> Double
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 :: Measurement -> Word64 -> Estimate
Estimate
{ estMean :: Measurement
estMean = Estimate -> Measurement
estMean (Measurement -> Measurement -> Estimate
predict Measurement
t1 Measurement
t2)
, estStdev :: Word64
estStdev = Word64 -> Word64 -> Word64
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 = Word64 -> Word64 -> Word64
forall a. Ord a => a -> a -> a
max (Integer -> Word64
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 Word64 -> Word64 -> Word64
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 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
prec }
hasGCStats :: Bool
#if MIN_VERSION_base(4,10,0)
hasGCStats :: Bool
hasGCStats = IO Bool -> Bool
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 (Word64, Word64, Word64) -> IO (Word64, Word64, Word64)
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)) (RTSStats -> (Word64, Word64, Word64))
-> IO RTSStats -> IO (Word64, Word64, Word64)
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
measure :: Word64 -> Benchmarkable -> IO Measurement
measure :: Word64 -> Benchmarkable -> IO Measurement
measure Word64
n (Benchmarkable Word64 -> IO ()
act) = do
IO ()
performGC
Word64
startTime <- Integer -> Word64
forall a. Num a => Integer -> a
fromInteger (Integer -> Word64) -> IO Integer -> IO Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Integer
getCPUTime
(Word64
startAllocs, Word64
startCopied, Word64
startMaxMemInUse) <- IO (Word64, Word64, Word64)
getAllocsAndCopied
Word64 -> IO ()
act Word64
n
Word64
endTime <- Integer -> Word64
forall a. Num a => Integer -> a
fromInteger (Integer -> Word64) -> IO Integer -> IO Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Integer
getCPUTime
(Word64
endAllocs, Word64
endCopied, Word64
endMaxMemInUse) <- IO (Word64, Word64, Word64)
getAllocsAndCopied
Measurement -> IO Measurement
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Measurement -> IO Measurement) -> Measurement -> IO Measurement
forall a b. (a -> b) -> a -> b
$ Measurement :: Word64 -> Word64 -> Word64 -> Word64 -> Measurement
Measurement
{ measTime :: Word64
measTime = Word64
endTime Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
startTime
, measAllocs :: Word64
measAllocs = Word64
endAllocs Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
startAllocs
, measCopied :: Word64
measCopied = Word64
endCopied Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
startCopied
, measMaxMem :: Word64
measMaxMem = Word64 -> Word64 -> Word64
forall a. Ord a => a -> a -> a
max Word64
endMaxMemInUse Word64
startMaxMemInUse
}
measureUntil :: Bool -> Timeout -> RelStDev -> Benchmarkable -> IO Estimate
measureUntil :: Bool -> Timeout -> RelStDev -> Benchmarkable -> IO Estimate
measureUntil Bool
_ Timeout
_ (RelStDev Double
targetRelStDev) Benchmarkable
b
| Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Double
targetRelStDev, Double
targetRelStDev Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0 = do
Measurement
t1 <- Word64 -> Benchmarkable -> IO Measurement
measure Word64
1 Benchmarkable
b
Estimate -> IO Estimate
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Estimate -> IO Estimate) -> Estimate -> IO Estimate
forall a b. (a -> b) -> a -> b
$ Estimate :: Measurement -> Word64 -> Estimate
Estimate { estMean :: Measurement
estMean = Measurement
t1, estStdev :: Word64
estStdev = Word64
0 }
measureUntil 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
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 Word64 -> Word64 -> Word64
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' Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
3 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Measurement -> Word64
measTime Measurement
t2) Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`quot` (Word64
1000000 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
10 Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`quot` Word64
12) Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer -> Word64
forall a. Num a => Integer -> a
fromInteger Integer
micros
isStDevInTargetRange :: Bool
isStDevInTargetRange = Word64
stdevN Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Double -> Word64
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
0 Double
targetRelStDev Double -> Double -> Double
forall a. Num a => a -> a -> a
* Word64 -> Double
word64ToDouble Word64
meanN)
scale :: Word64 -> Word64
scale = (Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`quot` Word64
n)
sumOfTs' :: Word64
sumOfTs' = Word64
sumOfTs Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Measurement -> Word64
measTime Measurement
t1
case Timeout
timeout of
Timeout
NoTimeout | Bool
warnIfNoTimeout, Word64
sumOfTs' Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Measurement -> Word64
measTime Measurement
t2 Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
100 Word64 -> Word64 -> Word64
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
_ -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
if Bool
isStDevInTargetRange Bool -> Bool -> Bool
|| Bool
isTimeoutSoon
then Estimate -> IO Estimate
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Estimate -> IO Estimate) -> Estimate -> IO Estimate
forall a b. (a -> b) -> a -> b
$ Estimate :: Measurement -> Word64 -> Estimate
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 Word64 -> Word64 -> Word64
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
= (((Estimate -> Double) -> IO Estimate -> IO Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1e12) (Double -> Double) -> (Estimate -> Double) -> Estimate -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Double
word64ToDouble (Word64 -> Double) -> (Estimate -> Word64) -> Estimate -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Measurement -> Word64
measTime (Measurement -> Word64)
-> (Estimate -> Measurement) -> Estimate -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Estimate -> Measurement
estMean) (IO Estimate -> IO Double)
-> (Benchmarkable -> IO Estimate) -> Benchmarkable -> IO Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Benchmarkable -> IO Estimate) -> Benchmarkable -> IO Double)
-> (RelStDev -> Benchmarkable -> IO Estimate)
-> RelStDev
-> Benchmarkable
-> IO Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
.)
((RelStDev -> Benchmarkable -> IO Estimate)
-> RelStDev -> Benchmarkable -> IO Double)
-> (Timeout -> RelStDev -> Benchmarkable -> IO Estimate)
-> Timeout
-> RelStDev
-> Benchmarkable
-> IO Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Timeout -> RelStDev -> Benchmarkable -> IO Estimate
measureUntil Bool
False
instance IsTest Benchmarkable where
testOptions :: Tagged Benchmarkable [OptionDescription]
testOptions = [OptionDescription] -> Tagged Benchmarkable [OptionDescription]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
[ Proxy RelStDev -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
Option (Proxy RelStDev
forall k (t :: k). Proxy t
Proxy :: Proxy RelStDev)
, Proxy FailIfSlower -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
Option (Proxy FailIfSlower
forall k (t :: k). Proxy t
Proxy :: Proxy FailIfSlower)
, Proxy FailIfFaster -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
Option (Proxy FailIfFaster
forall k (t :: k). Proxy t
Proxy :: Proxy FailIfFaster)
]
run :: OptionSet -> Benchmarkable -> (Progress -> IO ()) -> IO Result
run OptionSet
opts Benchmarkable
b = IO Result -> (Progress -> IO ()) -> IO Result
forall a b. a -> b -> a
const (IO Result -> (Progress -> IO ()) -> IO Result)
-> IO Result -> (Progress -> IO ()) -> IO Result
forall a b. (a -> b) -> a -> b
$ case NumThreads -> Int
getNumThreads (OptionSet -> NumThreads
forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
opts) of
Int
1 -> do
Estimate
est <- Bool -> Timeout -> RelStDev -> Benchmarkable -> IO Estimate
measureUntil Bool
True (OptionSet -> Timeout
forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
opts) (OptionSet -> RelStDev
forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
opts) Benchmarkable
b
Result -> IO Result
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result -> IO Result) -> Result -> IO Result
forall a b. (a -> b) -> a -> b
$ String -> Result
testPassed (String -> Result) -> String -> Result
forall a b. (a -> b) -> a -> b
$ Response -> String
forall a. Show a => a -> String
show (Estimate -> FailIfSlower -> FailIfFaster -> Response
Response Estimate
est (OptionSet -> FailIfSlower
forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
opts) (OptionSet -> FailIfFaster
forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
opts))
Int
_ -> Result -> IO Result
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result -> IO Result) -> Result -> IO Result
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 = String -> Benchmarkable -> Benchmark
forall t. IsTest t => String -> t -> Benchmark
singleTest
bgroup :: String -> [Benchmark] -> Benchmark
bgroup :: String -> [Benchmark] -> Benchmark
bgroup = String -> [Benchmark] -> Benchmark
testGroup
#if MIN_VERSION_tasty(1,2,0)
bcompare :: String -> Benchmark -> Benchmark
bcompare :: String -> Benchmark -> Benchmark
bcompare String
s = case String -> Maybe Expr
parseExpr String
s of
Maybe Expr
Nothing -> String -> Benchmark -> Benchmark
forall a. HasCallStack => String -> a
error (String -> Benchmark -> Benchmark)
-> String -> Benchmark -> Benchmark
forall a b. (a -> b) -> a -> b
$ String
"Could not parse bcompare pattern " String -> ShowS
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
"tasty-bench") Expr
e)
#endif
type Benchmark = TestTree
defaultMain :: [Benchmark] -> IO ()
defaultMain :: [Benchmark] -> IO ()
defaultMain = [Ingredient] -> Benchmark -> IO ()
Test.Tasty.defaultMainWithIngredients [Ingredient]
benchIngredients (Benchmark -> IO ())
-> ([Benchmark] -> Benchmark) -> [Benchmark] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Benchmark] -> Benchmark
testGroup String
"All"
benchIngredients :: [Ingredient]
benchIngredients :: [Ingredient]
benchIngredients = [Ingredient
listingTests, Ingredient -> Ingredient -> Ingredient
composeReporters Ingredient
consoleBenchReporter (Ingredient -> Ingredient -> Ingredient
composeReporters Ingredient
csvReporter Ingredient
svgReporter)]
funcToBench :: (b -> c) -> (a -> b) -> a -> Benchmarkable
funcToBench :: (b -> c) -> (a -> b) -> a -> Benchmarkable
funcToBench b -> c
frc = ((Word64 -> IO ()) -> Benchmarkable
Benchmarkable ((Word64 -> IO ()) -> Benchmarkable)
-> (a -> Word64 -> IO ()) -> a -> Benchmarkable
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((a -> Word64 -> IO ()) -> a -> Benchmarkable)
-> ((a -> b) -> a -> Word64 -> IO ())
-> (a -> b)
-> a
-> Benchmarkable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> a -> Word64 -> IO ()
forall t t. (Eq t, Num t) => (t -> b) -> t -> t -> IO ()
go
where
go :: (t -> b) -> t -> t -> IO ()
go t -> b
f t
x t
n
| t
n t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0 = () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
| Bool
otherwise = do
c
_ <- c -> IO c
forall a. a -> IO a
evaluate (b -> c
frc (t -> b
f t
x))
(t -> b) -> t -> t -> IO ()
go t -> b
f t
x (t
n t -> t -> t
forall a. Num a => a -> a -> a
- t
1)
{-# INLINE funcToBench #-}
nf :: NFData b => (a -> b) -> a -> Benchmarkable
nf :: (a -> b) -> a -> Benchmarkable
nf = (b -> b) -> (a -> b) -> a -> Benchmarkable
forall b c a. (b -> c) -> (a -> b) -> a -> Benchmarkable
funcToBench b -> b
forall a. NFData a => a -> a
force
{-# INLINE nf #-}
whnf :: (a -> b) -> a -> Benchmarkable
whnf :: (a -> b) -> a -> Benchmarkable
whnf = (b -> b) -> (a -> b) -> a -> Benchmarkable
forall b c a. (b -> c) -> (a -> b) -> a -> Benchmarkable
funcToBench b -> b
forall a. a -> a
id
{-# INLINE whnf #-}
ioToBench :: (b -> c) -> IO b -> Benchmarkable
ioToBench :: (b -> c) -> IO b -> Benchmarkable
ioToBench b -> c
frc IO b
act = (Word64 -> IO ()) -> Benchmarkable
Benchmarkable Word64 -> IO ()
forall t. (Eq t, Num t) => t -> IO ()
go
where
go :: t -> IO ()
go t
n
| t
n t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0 = () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
| Bool
otherwise = do
b
val <- IO b
act
c
_ <- c -> IO c
forall a. a -> IO a
evaluate (b -> c
frc b
val)
t -> IO ()
go (t
n t -> t -> t
forall a. Num a => a -> a -> a
- t
1)
{-# INLINE ioToBench #-}
nfIO :: NFData a => IO a -> Benchmarkable
nfIO :: IO a -> Benchmarkable
nfIO = (a -> a) -> IO a -> Benchmarkable
forall b c. (b -> c) -> IO b -> Benchmarkable
ioToBench a -> a
forall a. NFData a => a -> a
force
{-# INLINE nfIO #-}
whnfIO :: IO a -> Benchmarkable
whnfIO :: IO a -> Benchmarkable
whnfIO = (a -> a) -> IO a -> Benchmarkable
forall b c. (b -> c) -> IO b -> Benchmarkable
ioToBench a -> a
forall a. a -> a
id
{-# INLINE whnfIO #-}
ioFuncToBench :: (b -> c) -> (a -> IO b) -> a -> Benchmarkable
ioFuncToBench :: (b -> c) -> (a -> IO b) -> a -> Benchmarkable
ioFuncToBench b -> c
frc = ((Word64 -> IO ()) -> Benchmarkable
Benchmarkable ((Word64 -> IO ()) -> Benchmarkable)
-> (a -> Word64 -> IO ()) -> a -> Benchmarkable
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((a -> Word64 -> IO ()) -> a -> Benchmarkable)
-> ((a -> IO b) -> a -> Word64 -> IO ())
-> (a -> IO b)
-> a
-> Benchmarkable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> IO b) -> a -> Word64 -> IO ()
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 t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0 = () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
| Bool
otherwise = do
b
val <- t -> IO b
f t
x
c
_ <- c -> IO 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 t -> t -> t
forall a. Num a => a -> a -> a
- t
1)
{-# INLINE ioFuncToBench #-}
nfAppIO :: NFData b => (a -> IO b) -> a -> Benchmarkable
nfAppIO :: (a -> IO b) -> a -> Benchmarkable
nfAppIO = (b -> b) -> (a -> IO b) -> a -> Benchmarkable
forall b c a. (b -> c) -> (a -> IO b) -> a -> Benchmarkable
ioFuncToBench b -> b
forall a. NFData a => a -> a
force
{-# INLINE nfAppIO #-}
whnfAppIO :: (a -> IO b) -> a -> Benchmarkable
whnfAppIO :: (a -> IO b) -> a -> Benchmarkable
whnfAppIO = (b -> b) -> (a -> IO b) -> a -> Benchmarkable
forall b c a. (b -> c) -> (a -> IO b) -> a -> Benchmarkable
ioFuncToBench b -> b
forall a. a -> a
id
{-# INLINE whnfAppIO #-}
env :: NFData env => IO env -> (env -> Benchmark) -> Benchmark
env :: IO env -> (env -> Benchmark) -> Benchmark
env IO env
res = IO env -> (env -> IO ()) -> (env -> Benchmark) -> Benchmark
forall env a.
NFData env =>
IO env -> (env -> IO a) -> (env -> Benchmark) -> Benchmark
envWithCleanup IO env
res (IO () -> env -> IO ()
forall a b. a -> b -> a
const (IO () -> env -> IO ()) -> IO () -> env -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
envWithCleanup :: NFData env => IO env -> (env -> IO a) -> (env -> Benchmark) -> Benchmark
envWithCleanup :: IO env -> (env -> IO a) -> (env -> Benchmark) -> Benchmark
envWithCleanup IO env
res env -> IO a
fin env -> Benchmark
f = IO env -> (env -> IO ()) -> (IO env -> Benchmark) -> Benchmark
forall a. IO a -> (a -> IO ()) -> (IO a -> Benchmark) -> Benchmark
withResource
(IO env
res IO env -> (env -> IO env) -> IO env
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= env -> IO env
forall a. a -> IO a
evaluate (env -> IO env) -> (env -> env) -> env -> IO env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. env -> env
forall a. NFData a => a -> a
force)
(IO a -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO a -> IO ()) -> (env -> IO a) -> env -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. env -> IO a
fin)
(env -> Benchmark
f (env -> Benchmark) -> (IO env -> env) -> IO env -> Benchmark
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO env -> env
forall a. IO a -> a
unsafePerformIO)
newtype CsvPath = CsvPath FilePath
deriving (Typeable)
instance IsOption (Maybe CsvPath) where
defaultValue :: Maybe CsvPath
defaultValue = Maybe CsvPath
forall a. Maybe a
Nothing
parseValue :: String -> Maybe (Maybe CsvPath)
parseValue = Maybe CsvPath -> Maybe (Maybe CsvPath)
forall a. a -> Maybe a
Just (Maybe CsvPath -> Maybe (Maybe CsvPath))
-> (String -> Maybe CsvPath) -> String -> Maybe (Maybe CsvPath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvPath -> Maybe CsvPath
forall a. a -> Maybe a
Just (CsvPath -> Maybe CsvPath)
-> (String -> CsvPath) -> String -> Maybe CsvPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CsvPath
CsvPath
optionName :: Tagged (Maybe CsvPath) String
optionName = String -> Tagged (Maybe CsvPath) String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"csv"
optionHelp :: Tagged (Maybe CsvPath) String
optionHelp = String -> Tagged (Maybe CsvPath) String
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 [Proxy (Maybe CsvPath) -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
Option (Proxy (Maybe CsvPath)
forall k (t :: k). Proxy t
Proxy :: Proxy (Maybe CsvPath))] ((OptionSet
-> Benchmark -> Maybe (StatusMap -> IO (Double -> IO Bool)))
-> Ingredient)
-> (OptionSet
-> Benchmark -> Maybe (StatusMap -> IO (Double -> IO Bool)))
-> Ingredient
forall a b. (a -> b) -> a -> b
$
\OptionSet
opts Benchmark
tree -> do
CsvPath String
path <- OptionSet -> Maybe CsvPath
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 = [(Int, String)] -> IntMap String
forall a. [(Int, a)] -> IntMap a
IM.fromDistinctAscList ([(Int, String)] -> IntMap String)
-> [(Int, String)] -> IntMap String
forall a b. (a -> b) -> a -> b
$ [Int] -> [String] -> [(Int, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [String]
names
(StatusMap -> IO (Double -> IO Bool))
-> Maybe (StatusMap -> IO (Double -> IO Bool))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((StatusMap -> IO (Double -> IO Bool))
-> Maybe (StatusMap -> IO (Double -> IO Bool)))
-> (StatusMap -> IO (Double -> IO Bool))
-> Maybe (StatusMap -> IO (Double -> IO Bool))
forall a b. (a -> b) -> a -> b
$ \StatusMap
smap -> do
case [String] -> Maybe String
forall a. Ord a => [a] -> Maybe a
findNonUniqueElement [String]
names of
Maybe String
Nothing -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just String
name -> do
Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"CSV report cannot proceed, because name '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' corresponds to two or more benchmarks. Please disambiguate them."
IO ()
forall a. IO a
exitFailure
let augmented :: IntMap (String, TVar Status)
augmented = (String -> TVar Status -> (String, TVar Status))
-> IntMap String -> StatusMap -> IntMap (String, TVar Status)
forall a b c. (a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
IM.intersectionWith (,) IntMap String
namesMap StatusMap
smap
IO Handle -> (Handle -> IO ()) -> (Handle -> IO ()) -> IO ()
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 (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Name,Mean (ps),2*Stdev (ps)" String -> ShowS
forall a. [a] -> [a] -> [a]
++
(if Bool
hasGCStats then String
",Allocated,Copied,Peak Memory" else String
"")
Handle -> IO Handle
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)
(Double -> IO Bool) -> IO (Double -> IO Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Double -> IO Bool) -> IO (Double -> IO Bool))
-> (Double -> IO Bool) -> IO (Double -> IO Bool)
forall a b. (a -> b) -> a -> b
$ IO Bool -> Double -> IO Bool
forall a b. a -> b -> a
const (IO Bool -> Double -> IO Bool) -> IO Bool -> Double -> IO Bool
forall a b. (a -> b) -> a -> b
$ StatusMap -> IO Bool
isSuccessful StatusMap
smap
findNonUniqueElement :: Ord a => [a] -> Maybe a
findNonUniqueElement :: [a] -> Maybe a
findNonUniqueElement = Set a -> [a] -> Maybe a
forall a. Ord a => Set a -> [a] -> Maybe a
go Set a
forall a. Set a
S.empty
where
go :: Set a -> [a] -> Maybe a
go Set a
_ [] = Maybe a
forall a. Maybe a
Nothing
go Set a
acc (a
x : [a]
xs)
| a
x a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set a
acc = a -> Maybe a
forall a. a -> Maybe a
Just a
x
| Bool
otherwise = Set a -> [a] -> Maybe a
go (a -> Set a -> Set a
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 = ((String, TVar Status) -> IO ())
-> IntMap (String, TVar Status) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (((String, TVar Status) -> IO ())
-> IntMap (String, TVar Status) -> IO ())
-> ((String, TVar Status) -> IO ())
-> IntMap (String, TVar Status)
-> IO ()
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 <- STM Result -> IO Result
forall a. STM a -> IO a
atomically (STM Result -> IO Result) -> STM Result -> IO Result
forall a b. (a -> b) -> a -> b
$ TVar Status -> STM Status
forall a. TVar a -> STM a
readTVar TVar Status
tv STM Status -> (Status -> STM Result) -> STM Result
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Status
s -> case Status
s of Done Result
r -> Result -> STM Result
forall (f :: * -> *) a. Applicative f => a -> f a
pure Result
r; Status
_ -> STM Result
forall a. STM a
retry
case String -> Maybe Response
forall a. Read a => String -> Maybe a
safeRead (Result -> String
resultDescription Result
r) of
Maybe Response
Nothing -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just (Response Estimate
est FailIfSlower
_ FailIfFaster
_) -> do
String
msg <- String -> IO String
formatMessage (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ Estimate -> String
csv Estimate
est
Handle -> String -> IO ()
hPutStrLn Handle
h (ShowS
encodeCsv String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
',' Char -> ShowS
forall a. a -> [a] -> [a]
: String
msg)
encodeCsv :: String -> String
encodeCsv :: ShowS
encodeCsv String
xs
| (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
xs) String
",\"\n\r"
= Char
'"' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go String
xs
| Bool
otherwise = String
xs
where
go :: ShowS
go [] = Char
'"' Char -> ShowS
forall a. a -> [a] -> [a]
: []
go (Char
'"' : String
ys) = Char
'"' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'"' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go String
ys
go (Char
y : String
ys) = Char
y Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go String
ys
newtype SvgPath = SvgPath FilePath
deriving (Typeable)
instance IsOption (Maybe SvgPath) where
defaultValue :: Maybe SvgPath
defaultValue = Maybe SvgPath
forall a. Maybe a
Nothing
parseValue :: String -> Maybe (Maybe SvgPath)
parseValue = Maybe SvgPath -> Maybe (Maybe SvgPath)
forall a. a -> Maybe a
Just (Maybe SvgPath -> Maybe (Maybe SvgPath))
-> (String -> Maybe SvgPath) -> String -> Maybe (Maybe SvgPath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SvgPath -> Maybe SvgPath
forall a. a -> Maybe a
Just (SvgPath -> Maybe SvgPath)
-> (String -> SvgPath) -> String -> Maybe SvgPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> SvgPath
SvgPath
optionName :: Tagged (Maybe SvgPath) String
optionName = String -> Tagged (Maybe SvgPath) String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"svg"
optionHelp :: Tagged (Maybe SvgPath) String
optionHelp = String -> Tagged (Maybe SvgPath) String
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 [Proxy (Maybe SvgPath) -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
Option (Proxy (Maybe SvgPath)
forall k (t :: k). Proxy t
Proxy :: Proxy (Maybe SvgPath))] ((OptionSet
-> Benchmark -> Maybe (StatusMap -> IO (Double -> IO Bool)))
-> Ingredient)
-> (OptionSet
-> Benchmark -> Maybe (StatusMap -> IO (Double -> IO Bool)))
-> Ingredient
forall a b. (a -> b) -> a -> b
$
\OptionSet
opts Benchmark
tree -> do
SvgPath String
path <- OptionSet -> Maybe SvgPath
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 = [(Int, String)] -> IntMap String
forall a. [(Int, a)] -> IntMap a
IM.fromDistinctAscList ([(Int, String)] -> IntMap String)
-> [(Int, String)] -> IntMap String
forall a b. (a -> b) -> a -> b
$ [Int] -> [String] -> [(Int, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [String]
names
(StatusMap -> IO (Double -> IO Bool))
-> Maybe (StatusMap -> IO (Double -> IO Bool))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((StatusMap -> IO (Double -> IO Bool))
-> Maybe (StatusMap -> IO (Double -> IO Bool)))
-> (StatusMap -> IO (Double -> IO Bool))
-> Maybe (StatusMap -> IO (Double -> IO Bool))
forall a b. (a -> b) -> a -> b
$ \StatusMap
smap -> do
IORef [(String, Estimate)]
ref <- [(String, Estimate)] -> IO (IORef [(String, Estimate)])
forall a. a -> IO (IORef a)
newIORef []
IORef [(String, Estimate)] -> IntMap (String, TVar Status) -> IO ()
svgCollect IORef [(String, Estimate)]
ref ((String -> TVar Status -> (String, TVar Status))
-> IntMap String -> StatusMap -> IntMap (String, TVar Status)
forall a b c. (a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
IM.intersectionWith (,) IntMap String
namesMap StatusMap
smap)
[(String, Estimate)]
res <- IORef [(String, Estimate)] -> IO [(String, Estimate)]
forall a. IORef a -> IO a
readIORef IORef [(String, Estimate)]
ref
String -> String -> IO ()
writeFile String
path ([(String, Estimate)] -> String
svgRender ([(String, Estimate)] -> [(String, Estimate)]
forall a. [a] -> [a]
reverse [(String, Estimate)]
res))
(Double -> IO Bool) -> IO (Double -> IO Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Double -> IO Bool) -> IO (Double -> IO Bool))
-> (Double -> IO Bool) -> IO (Double -> IO Bool)
forall a b. (a -> b) -> a -> b
$ IO Bool -> Double -> IO Bool
forall a b. a -> b -> a
const (IO Bool -> Double -> IO Bool) -> IO Bool -> Double -> IO Bool
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 ([TVar Status] -> IO Bool)
-> (StatusMap -> [TVar Status]) -> StatusMap -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StatusMap -> [TVar Status]
forall a. IntMap a -> [a]
IM.elems
where
go :: [TVar Status] -> IO Bool
go [] = Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
go (TVar Status
tv : [TVar Status]
tvs) = do
Bool
b <- STM Bool -> IO Bool
forall a. STM a -> IO a
atomically (STM Bool -> IO Bool) -> STM Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ TVar Status -> STM Status
forall a. TVar a -> STM a
readTVar TVar Status
tv STM Status -> (Status -> STM Bool) -> STM Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Status
s -> case Status
s of Done Result
r -> Bool -> STM Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result -> Bool
resultSuccessful Result
r); Status
_ -> STM Bool
forall a. STM a
retry
if Bool
b then [TVar Status] -> IO Bool
go [TVar Status]
tvs else Bool -> IO Bool
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 = ((String, TVar Status) -> IO ())
-> IntMap (String, TVar Status) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (((String, TVar Status) -> IO ())
-> IntMap (String, TVar Status) -> IO ())
-> ((String, TVar Status) -> IO ())
-> IntMap (String, TVar Status)
-> IO ()
forall a b. (a -> b) -> a -> b
$ \(String
name, TVar Status
tv) -> do
Result
r <- STM Result -> IO Result
forall a. STM a -> IO a
atomically (STM Result -> IO Result) -> STM Result -> IO Result
forall a b. (a -> b) -> a -> b
$ TVar Status -> STM Status
forall a. TVar a -> STM a
readTVar TVar Status
tv STM Status -> (Status -> STM Result) -> STM Result
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Status
s -> case Status
s of Done Result
r -> Result -> STM Result
forall (f :: * -> *) a. Applicative f => a -> f a
pure Result
r; Status
_ -> STM Result
forall a. STM a
retry
case String -> Maybe Response
forall a. Read a => String -> Maybe a
safeRead (Result -> String
resultDescription Result
r) of
Maybe Response
Nothing -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just (Response Estimate
est FailIfSlower
_ FailIfFaster
_) -> IORef [(String, Estimate)]
-> ([(String, Estimate)] -> [(String, Estimate)]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef [(String, Estimate)]
ref ((String
name, Estimate
est) (String, Estimate) -> [(String, Estimate)] -> [(String, Estimate)]
forall a. a -> [a] -> [a]
:)
svgRender :: [(TestName, Estimate)] -> String
svgRender :: [(String, Estimate)] -> String
svgRender [] = String
""
svgRender [(String, Estimate)]
pairs = String
header String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((Word64 -> (String, Estimate) -> String)
-> [Word64] -> [(String, Estimate)] -> [String]
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 (ShowS
forall a. [a] -> [a]
dropAllPrefix String
name) Estimate
est)
[Word64
0..]
[(String, Estimate)]
pairs) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
footer
where
dropAllPrefix :: [a] -> [a]
dropAllPrefix
| ((String, Estimate) -> Bool) -> [(String, Estimate)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((String
"All." String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) (String -> Bool)
-> ((String, Estimate) -> String) -> (String, Estimate) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Estimate) -> String
forall a b. (a, b) -> a
fst) [(String, Estimate)]
pairs = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
4
| Bool
otherwise = [a] -> [a]
forall a. a -> a
id
l :: Word64
l = [(String, Estimate)] -> Word64
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 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
2 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
stdev
xMax :: Double
xMax = Word64 -> Double
word64ToDouble (Word64 -> Double) -> Word64 -> Double
forall a b. (a -> b) -> a -> b
$ [Word64] -> Word64
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Word64] -> Word64) -> [Word64] -> Word64
forall a b. (a -> b) -> a -> b
$ Word64
forall a. Bounded a => a
minBound Word64 -> [Word64] -> [Word64]
forall a. a -> [a] -> [a]
: ((String, Estimate) -> Word64) -> [(String, Estimate)] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map (Estimate -> Word64
findMaxX (Estimate -> Word64)
-> ((String, Estimate) -> Estimate) -> (String, Estimate) -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Estimate) -> Estimate
forall a b. (a, b) -> b
snd) [(String, Estimate)]
pairs
header :: String
header = String -> Word64 -> Double -> Word64 -> Double -> String
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 Word64 -> Word64 -> Word64
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 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
55 Word64 -> Word64 -> Word64
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 String -> Double
forall i a. Num i => [a] -> i
genericLength String
shortTextContent Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
glyphWidth Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
boxWidth then String
longText else String
shortText) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
box
where
y :: Word64
y = Word64 -> Word64
svgItemOffset Word64
i
y' :: Word64
y' = Word64
y Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ (Word64
svgFontSize Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
3) Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`quot` Word64
8
y1 :: Word64
y1 = Word64
y' Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
whiskerMargin
y2 :: Word64
y2 = Word64
y' Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
boxHeight Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`quot` Word64
2
y3 :: Word64
y3 = Word64
y' Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
boxHeight Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
whiskerMargin
x1 :: Double
x1 = Double
boxWidth Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
whiskerWidth
x2 :: Double
x2 = Double
boxWidth Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
whiskerWidth
deg :: Word64
deg = (Word64
i Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
360) Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`quot` Word64
iMax
glyphWidth :: Double
glyphWidth = Word64 -> Double
word64ToDouble Word64
svgFontSize Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
scale :: Word64 -> Double
scale Word64
w = Word64 -> Double
word64ToDouble Word64
w Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
svgCanvasWidth Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
svgCanvasMargin) Double -> Double -> Double
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 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
stdev)
boxHeight :: Word64
boxHeight = Word64
22
whiskerMargin :: Word64
whiskerMargin = Word64
5
box :: String
box = String
-> String
-> Word64
-> Word64
-> Double
-> Word64
-> Word64
-> Word64
-> Double
-> Double
-> Word64
-> Word64
-> Double
-> Double
-> Word64
-> Word64
-> Double
-> Double
-> Word64
-> Word64
-> String
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"
String -> ShowS
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"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"<g stroke=\"hsl(%i, 100%%, 40%%)\">"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"<line x1=\"%f\" x2=\"%f\" y1=\"%i\" y2=\"%i\" />\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"<line x1=\"%f\" x2=\"%f\" y1=\"%i\" y2=\"%i\" />\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"<line x1=\"%f\" x2=\"%f\" y1=\"%i\" y2=\"%i\" />\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"</g>\n</g>\n"
longText :: String
longText = String -> Word64 -> Word64 -> String -> Word64 -> Double -> ShowS
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"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"<text y=\"%i\">%s</text>\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"<text y=\"%i\" x=\"%f\" text-anchor=\"end\">%s</text>\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"</g>\n"
shortTextContent :: String
shortTextContent = ShowS
encodeSvg String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> String
showPicos4 (Measurement -> Word64
measTime Measurement
m)
shortText :: String
shortText = String -> Word64 -> Word64 -> ShowS
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
'&' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'l' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
't' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
';' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
encodeSvg String
xs
encodeSvg (Char
'&' : String
xs) = Char
'&' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'a' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'm' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'p' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
';' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
encodeSvg String
xs
encodeSvg (Char
x : String
xs) = Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
encodeSvg String
xs
newtype BaselinePath = BaselinePath FilePath
deriving (Typeable)
instance IsOption (Maybe BaselinePath) where
defaultValue :: Maybe BaselinePath
defaultValue = Maybe BaselinePath
forall a. Maybe a
Nothing
parseValue :: String -> Maybe (Maybe BaselinePath)
parseValue = Maybe BaselinePath -> Maybe (Maybe BaselinePath)
forall a. a -> Maybe a
Just (Maybe BaselinePath -> Maybe (Maybe BaselinePath))
-> (String -> Maybe BaselinePath)
-> String
-> Maybe (Maybe BaselinePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BaselinePath -> Maybe BaselinePath
forall a. a -> Maybe a
Just (BaselinePath -> Maybe BaselinePath)
-> (String -> BaselinePath) -> String -> Maybe BaselinePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> BaselinePath
BaselinePath
optionName :: Tagged (Maybe BaselinePath) String
optionName = String -> Tagged (Maybe BaselinePath) String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"baseline"
optionHelp :: Tagged (Maybe BaselinePath) String
optionHelp = String -> Tagged (Maybe BaselinePath) String
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 Result -> Result -> Result))
-> Ingredient
modifyConsoleReporter [Proxy (Maybe BaselinePath) -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
Option (Proxy (Maybe BaselinePath)
forall k (t :: k). Proxy t
Proxy :: Proxy (Maybe BaselinePath))] ((OptionSet -> IO (String -> Maybe Result -> Result -> Result))
-> Ingredient)
-> (OptionSet -> IO (String -> Maybe Result -> Result -> Result))
-> Ingredient
forall a b. (a -> b) -> a -> b
$ \OptionSet
opts -> do
Set String
baseline <- case OptionSet -> Maybe BaselinePath
forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
opts of
Maybe BaselinePath
Nothing -> Set String -> IO (Set String)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set String
forall a. Set a
S.empty
Just (BaselinePath String
path) -> [String] -> Set String
forall a. Ord a => [a] -> Set a
S.fromList ([String] -> Set String)
-> (String -> [String]) -> String -> Set String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
joinQuotedFields ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines (String -> Set String) -> IO String -> IO (Set String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> IO String
readFile String
path IO String -> (String -> IO String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO String
forall a. a -> IO a
evaluate (String -> IO String) -> ShowS -> String -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. NFData a => a -> a
force)
let pretty :: Estimate -> String
pretty = if Bool
hasGCStats then Estimate -> String
prettyEstimateWithGC else Estimate -> String
prettyEstimate
(String -> Maybe Result -> Result -> Result)
-> IO (String -> Maybe Result -> Result -> Result)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((String -> Maybe Result -> Result -> Result)
-> IO (String -> Maybe Result -> Result -> Result))
-> (String -> Maybe Result -> Result -> Result)
-> IO (String -> Maybe Result -> Result -> Result)
forall a b. (a -> b) -> a -> b
$ \String
name Maybe Result
depR Result
r -> case String -> Maybe Response
forall a. Read a => String -> Maybe a
safeRead (Result -> String
resultDescription Result
r) of
Maybe Response
Nothing -> Result
r
Just (Response Estimate
est (FailIfSlower Double
ifSlow) (FailIfFaster Double
ifFast)) ->
(if Bool
isAcceptable then Result -> Result
forall a. a -> a
id else Result -> Result
forceFail)
Result
r { resultDescription :: String
resultDescription = Estimate -> String
pretty Estimate
est String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
bcomp String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int64 -> String
formatSlowDown Int64
slowDown }
where
slowDown :: Int64
slowDown = Set String -> String -> Estimate -> Int64
compareVsBaseline Set String
baseline String
name Estimate
est
isAcceptable :: Bool
isAcceptable
= Int64 -> Double
int64ToDouble Int64
slowDown Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
100 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
ifSlow
Bool -> Bool -> Bool
&& Int64 -> Double
int64ToDouble Int64
slowDown Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= -Double
100 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
ifFast
bcomp :: String
bcomp = case Maybe Result
depR Maybe Result -> (Result -> Maybe Response) -> Maybe Response
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Maybe Response
forall a. Read a => String -> Maybe a
safeRead (String -> Maybe Response)
-> (Result -> String) -> Result -> Maybe Response
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result -> String
resultDescription of
Maybe Response
Nothing -> String
""
Just (Response Estimate
depEst FailIfSlower
_ FailIfFaster
_) -> String -> Double -> String
forall r. PrintfType r => String -> r
printf String
", %.2fx" (Estimate -> Double
estTime Estimate
est Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Estimate -> Double
estTime Estimate
depEst)
joinQuotedFields :: [String] -> [String]
joinQuotedFields :: [String] -> [String]
joinQuotedFields [] = []
joinQuotedFields (String
x : [String]
xs)
| String -> Bool
areQuotesBalanced String
x = String
x String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String]
joinQuotedFields [String]
xs
| Bool
otherwise = case (String -> Bool) -> [String] -> ([String], [String])
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 String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
ys [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
z]) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String]
joinQuotedFields [String]
zs
where
areQuotesBalanced :: String -> Bool
areQuotesBalanced = Int -> Bool
forall a. Integral a => a -> Bool
even (Int -> Bool) -> (String -> Int) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> ShowS -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"')
estTime :: Estimate -> Double
estTime :: Estimate -> Double
estTime = Word64 -> Double
word64ToDouble (Word64 -> Double) -> (Estimate -> Word64) -> Estimate -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Measurement -> Word64
measTime (Measurement -> Word64)
-> (Estimate -> Measurement) -> Estimate -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Estimate -> Measurement
estMean
compareVsBaseline :: S.Set String -> TestName -> Estimate -> Int64
compareVsBaseline :: Set String -> String -> Estimate -> Int64
compareVsBaseline Set String
baseline String
name (Estimate Measurement
m Word64
stdev) = case Maybe (Int64, Int64)
mOld of
Maybe (Int64, Int64)
Nothing -> Int64
0
Just (Int64
oldTime, Int64
oldDoubleSigma)
| Int64 -> Int64
forall a. Num a => a -> a
abs (Int64
time Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
oldTime) Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
max (Int64
2 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Word64 -> Int64
word64ToInt64 Word64
stdev) Int64
oldDoubleSigma -> Int64
0
| Bool
otherwise -> Int64
100 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* (Int64
time Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
oldTime) Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`quot` Int64
oldTime
where
time :: Int64
time = Word64 -> Int64
word64ToInt64 (Word64 -> Int64) -> Word64 -> Int64
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 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
","
(String
line, Set String
furtherLines) <- Set String -> Maybe (String, Set String)
forall a. Set a -> Maybe (a, Set a)
S.minView (Set String -> Maybe (String, Set String))
-> Set String -> Maybe (String, Set String)
forall a b. (a -> b) -> a -> b
$ (Set String, Set String) -> Set String
forall a b. (a, b) -> b
snd ((Set String, Set String) -> Set String)
-> (Set String, Set String) -> Set String
forall a b. (a -> b) -> a -> b
$ String -> Set String -> (Set String, Set String)
forall a. Ord a => a -> Set a -> (Set a, Set a)
S.split String
prefix Set String
baseline
case Set String -> Maybe (String, Set String)
forall a. Set a -> Maybe (a, Set a)
S.minView Set String
furtherLines of
Maybe (String, Set String)
Nothing -> () -> Maybe ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just (String
nextLine, Set String
_) -> case String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
prefix String
nextLine of
Maybe String
Nothing -> () -> Maybe ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just{} -> Maybe ()
forall a. Maybe a
Nothing
(String
timeCell, Char
',' : String
rest) <- (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
',') (String -> (String, String))
-> Maybe String -> Maybe (String, String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
prefix String
line
let doubleSigmaCell :: String
doubleSigmaCell = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
',') String
rest
(,) (Int64 -> Int64 -> (Int64, Int64))
-> Maybe Int64 -> Maybe (Int64 -> (Int64, Int64))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Int64
forall a. Read a => String -> Maybe a
safeRead String
timeCell Maybe (Int64 -> (Int64, Int64))
-> Maybe Int64 -> Maybe (Int64, Int64)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Maybe Int64
forall a. Read a => String -> Maybe a
safeRead String
doubleSigmaCell
formatSlowDown :: Int64 -> String
formatSlowDown :: Int64 -> String
formatSlowDown Int64
n = case Int64
n Int64 -> Int64 -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Int64
0 of
Ordering
LT -> String -> Int64 -> String
forall r. PrintfType r => String -> r
printf String
", %2i%% faster than baseline" (-Int64
n)
Ordering
EQ -> String
""
Ordering
GT -> String -> Int64 -> String
forall r. PrintfType r => String -> r
printf String
", %2i%% slower than baseline" Int64
n
forceFail :: Result -> Result
forceFail :: Result -> Result
forceFail Result
r = Result
r { resultOutcome :: Outcome
resultOutcome = FailureReason -> Outcome
Failure FailureReason
TestFailed, resultShortDescription :: String
resultShortDescription = String
"FAIL" }
modifyConsoleReporter
:: [OptionDescription]
-> (OptionSet -> IO (TestName -> Maybe Result -> Result -> Result))
-> Ingredient
modifyConsoleReporter :: [OptionDescription]
-> (OptionSet -> IO (String -> Maybe Result -> Result -> Result))
-> Ingredient
modifyConsoleReporter [OptionDescription]
desc' OptionSet -> IO (String -> Maybe Result -> Result -> Result)
iof = [OptionDescription]
-> (OptionSet
-> Benchmark -> Maybe (StatusMap -> IO (Double -> IO Bool)))
-> Ingredient
TestReporter ([OptionDescription]
desc [OptionDescription] -> [OptionDescription] -> [OptionDescription]
forall a. [a] -> [a] -> [a]
++ [OptionDescription]
desc') ((OptionSet
-> Benchmark -> Maybe (StatusMap -> IO (Double -> IO Bool)))
-> Ingredient)
-> (OptionSet
-> Benchmark -> Maybe (StatusMap -> IO (Double -> IO Bool)))
-> Ingredient
forall a b. (a -> b) -> a -> b
$ \OptionSet
opts Benchmark
tree ->
let nameSeqs :: IntMap (Seq String)
nameSeqs = [(Int, Seq String)] -> IntMap (Seq String)
forall a. [(Int, a)] -> IntMap a
IM.fromDistinctAscList ([(Int, Seq String)] -> IntMap (Seq String))
-> [(Int, Seq String)] -> IntMap (Seq String)
forall a b. (a -> b) -> a -> b
$ [Int] -> [Seq String] -> [(Int, Seq String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Seq String] -> [(Int, Seq String)])
-> [Seq String] -> [(Int, Seq String)]
forall a b. (a -> b) -> a -> b
$ OptionSet -> Benchmark -> [Seq String]
testNameSeqs OptionSet
opts Benchmark
tree
namesAndDeps :: IntMap (String, Maybe Int)
namesAndDeps = [(Int, (String, Maybe Int))] -> IntMap (String, Maybe Int)
forall a. [(Int, a)] -> IntMap a
IM.fromDistinctAscList ([(Int, (String, Maybe Int))] -> IntMap (String, Maybe Int))
-> [(Int, (String, Maybe Int))] -> IntMap (String, Maybe Int)
forall a b. (a -> b) -> a -> b
$ [Int] -> [(String, Maybe Int)] -> [(Int, (String, Maybe Int))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([(String, Maybe Int)] -> [(Int, (String, Maybe Int))])
-> [(String, Maybe Int)] -> [(Int, (String, Maybe Int))]
forall a b. (a -> b) -> a -> b
$ ((String, [Int]) -> (String, Maybe Int))
-> [(String, [Int])] -> [(String, Maybe Int)]
forall a b. (a -> b) -> [a] -> [b]
map (([Int] -> Maybe Int) -> (String, [Int]) -> (String, Maybe Int)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second [Int] -> Maybe Int
forall a. [a] -> Maybe a
isSingle)
([(String, [Int])] -> [(String, Maybe Int)])
-> [(String, [Int])] -> [(String, Maybe Int)]
forall a b. (a -> b) -> a -> b
$ IntMap (Seq String) -> OptionSet -> Benchmark -> [(String, [Int])]
testNamesAndDeps IntMap (Seq String)
nameSeqs OptionSet
opts Benchmark
tree
modifySMap :: StatusMap -> IO StatusMap
modifySMap = (OptionSet -> IO (String -> Maybe Result -> Result -> Result)
iof OptionSet
opts IO (String -> Maybe Result -> Result -> Result)
-> ((String -> Maybe Result -> Result -> Result) -> IO StatusMap)
-> IO StatusMap
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=) (((String -> Maybe Result -> Result -> Result) -> IO StatusMap)
-> IO StatusMap)
-> (StatusMap
-> (String -> Maybe Result -> Result -> Result) -> IO StatusMap)
-> StatusMap
-> IO StatusMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String -> Maybe Result -> Result -> Result)
-> IntMap (String, Maybe Int, TVar Status) -> IO StatusMap)
-> IntMap (String, Maybe Int, TVar Status)
-> (String -> Maybe Result -> Result -> Result)
-> IO StatusMap
forall a b c. (a -> b -> c) -> b -> a -> c
flip (String -> Maybe Result -> Result -> Result)
-> IntMap (String, Maybe Int, TVar Status) -> IO StatusMap
postprocessResult
(IntMap (String, Maybe Int, TVar Status)
-> (String -> Maybe Result -> Result -> Result) -> IO StatusMap)
-> (StatusMap -> IntMap (String, Maybe Int, TVar Status))
-> StatusMap
-> (String -> Maybe Result -> Result -> Result)
-> IO StatusMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, Maybe Int)
-> TVar Status -> (String, Maybe Int, TVar Status))
-> IntMap (String, Maybe Int)
-> StatusMap
-> IntMap (String, Maybe Int, TVar Status)
forall a b c. (a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
IM.intersectionWith (\(String
a, Maybe Int
b) TVar Status
c -> (String
a, Maybe Int
b, TVar Status
c)) IntMap (String, Maybe Int)
namesAndDeps
in (StatusMap -> IO StatusMap
modifySMap (StatusMap -> IO StatusMap)
-> (StatusMap -> IO (Double -> IO Bool))
-> StatusMap
-> IO (Double -> IO Bool)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>) ((StatusMap -> IO (Double -> IO Bool))
-> StatusMap -> IO (Double -> IO Bool))
-> Maybe (StatusMap -> IO (Double -> IO Bool))
-> Maybe (StatusMap -> IO (Double -> IO Bool))
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
_ -> String
-> ([OptionDescription],
OptionSet
-> Benchmark -> Maybe (StatusMap -> IO (Double -> IO Bool)))
forall a. HasCallStack => String -> a
error String
"modifyConsoleReporter: consoleTestReporter must be TestReporter"
isSingle :: [a] -> Maybe a
isSingle [a
a] = a -> Maybe a
forall a. a -> Maybe a
Just a
a
isSingle [a]
_ = Maybe a
forall a. Maybe a
Nothing
testNameSeqs :: OptionSet -> TestTree -> [Seq TestName]
testNameSeqs :: OptionSet -> Benchmark -> [Seq String]
testNameSeqs = TreeFold [Seq String] -> OptionSet -> Benchmark -> [Seq String]
forall b. Monoid b => TreeFold b -> OptionSet -> Benchmark -> b
foldTestTree TreeFold [Seq String]
forall b. Monoid b => TreeFold b
trivialFold
{ foldSingle :: forall t. IsTest t => OptionSet -> String -> t -> [Seq String]
foldSingle = (String -> t -> [Seq String])
-> OptionSet -> String -> t -> [Seq String]
forall a b. a -> b -> a
const ((String -> t -> [Seq String])
-> OptionSet -> String -> t -> [Seq String])
-> (String -> t -> [Seq String])
-> OptionSet
-> String
-> t
-> [Seq String]
forall a b. (a -> b) -> a -> b
$ [Seq String] -> t -> [Seq String]
forall a b. a -> b -> a
const ([Seq String] -> t -> [Seq String])
-> (String -> [Seq String]) -> String -> t -> [Seq String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Seq String -> [Seq String] -> [Seq String]
forall a. a -> [a] -> [a]
:[]) (Seq String -> [Seq String])
-> (String -> Seq String) -> String -> [Seq String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Seq String
forall a. a -> Seq a
Seq.singleton
#if MIN_VERSION_tasty(1,4,0)
, foldGroup :: OptionSet -> String -> [Seq String] -> [Seq String]
foldGroup = (String -> [Seq String] -> [Seq String])
-> OptionSet -> String -> [Seq String] -> [Seq String]
forall a b. a -> b -> a
const ((String -> [Seq String] -> [Seq String])
-> OptionSet -> String -> [Seq String] -> [Seq String])
-> (String -> [Seq String] -> [Seq String])
-> OptionSet
-> String
-> [Seq String]
-> [Seq String]
forall a b. (a -> b) -> a -> b
$ (Seq String -> Seq String) -> [Seq String] -> [Seq String]
forall a b. (a -> b) -> [a] -> [b]
map ((Seq String -> Seq String) -> [Seq String] -> [Seq String])
-> (String -> Seq String -> Seq String)
-> String
-> [Seq String]
-> [Seq String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Seq String -> Seq String
forall a. a -> Seq a -> Seq a
(<|)
#else
, foldGroup = map . (<|)
#endif
}
testNamesAndDeps :: IntMap (Seq TestName) -> OptionSet -> TestTree -> [(TestName, [IM.Key])]
testNamesAndDeps :: IntMap (Seq String) -> OptionSet -> Benchmark -> [(String, [Int])]
testNamesAndDeps IntMap (Seq String)
im = TreeFold [(String, [Int])]
-> OptionSet -> Benchmark -> [(String, [Int])]
forall b. Monoid b => TreeFold b -> OptionSet -> Benchmark -> b
foldTestTree TreeFold [(String, [Int])]
forall b. Monoid b => TreeFold b
trivialFold
{ foldSingle :: forall t. IsTest t => OptionSet -> String -> t -> [(String, [Int])]
foldSingle = (String -> t -> [(String, [Int])])
-> OptionSet -> String -> t -> [(String, [Int])]
forall a b. a -> b -> a
const ((String -> t -> [(String, [Int])])
-> OptionSet -> String -> t -> [(String, [Int])])
-> (String -> t -> [(String, [Int])])
-> OptionSet
-> String
-> t
-> [(String, [Int])]
forall a b. (a -> b) -> a -> b
$ [(String, [Int])] -> t -> [(String, [Int])]
forall a b. a -> b -> a
const ([(String, [Int])] -> t -> [(String, [Int])])
-> (String -> [(String, [Int])])
-> String
-> t
-> [(String, [Int])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, [Int]) -> [(String, [Int])] -> [(String, [Int])]
forall a. a -> [a] -> [a]
: []) ((String, [Int]) -> [(String, [Int])])
-> (String -> (String, [Int])) -> String -> [(String, [Int])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (, [])
#if MIN_VERSION_tasty(1,4,0)
, foldGroup :: OptionSet -> String -> [(String, [Int])] -> [(String, [Int])]
foldGroup = (String -> [(String, [Int])] -> [(String, [Int])])
-> OptionSet -> String -> [(String, [Int])] -> [(String, [Int])]
forall a b. a -> b -> a
const ((String -> [(String, [Int])] -> [(String, [Int])])
-> OptionSet -> String -> [(String, [Int])] -> [(String, [Int])])
-> (String -> [(String, [Int])] -> [(String, [Int])])
-> OptionSet
-> String
-> [(String, [Int])]
-> [(String, [Int])]
forall a b. (a -> b) -> a -> b
$ ((String, [Int]) -> (String, [Int]))
-> [(String, [Int])] -> [(String, [Int])]
forall a b. (a -> b) -> [a] -> [b]
map (((String, [Int]) -> (String, [Int]))
-> [(String, [Int])] -> [(String, [Int])])
-> (String -> (String, [Int]) -> (String, [Int]))
-> String
-> [(String, [Int])]
-> [(String, [Int])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> (String, [Int]) -> (String, [Int])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (ShowS -> (String, [Int]) -> (String, [Int]))
-> (String -> ShowS)
-> String
-> (String, [Int])
-> (String, [Int])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
forall a. [a] -> [a] -> [a]
(++) (String -> ShowS) -> ShowS -> String -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".")
, foldAfter :: OptionSet
-> DependencyType -> Expr -> [(String, [Int])] -> [(String, [Int])]
foldAfter = (DependencyType -> Expr -> [(String, [Int])] -> [(String, [Int])])
-> OptionSet
-> DependencyType
-> Expr
-> [(String, [Int])]
-> [(String, [Int])]
forall a b. a -> b -> a
const DependencyType -> Expr -> [(String, [Int])] -> [(String, [Int])]
forall d. DependencyType -> Expr -> [(d, [Int])] -> [(d, [Int])]
foldDeps
#else
, foldGroup = map . first . (++) . (++ ".")
#if MIN_VERSION_tasty(1,2,0)
, foldAfter = foldDeps
#endif
#endif
}
#if MIN_VERSION_tasty(1,2,0)
where
foldDeps :: DependencyType -> Expr -> [(d, [Int])] -> [(d, [Int])]
foldDeps DependencyType
AllSucceed (And (StringLit String
"tasty-bench") Expr
p) =
((d, [Int]) -> (d, [Int])) -> [(d, [Int])] -> [(d, [Int])]
forall a b. (a -> b) -> [a] -> [b]
map (((d, [Int]) -> (d, [Int])) -> [(d, [Int])] -> [(d, [Int])])
-> ((d, [Int]) -> (d, [Int])) -> [(d, [Int])] -> [(d, [Int])]
forall a b. (a -> b) -> a -> b
$ ([Int] -> [Int]) -> (d, [Int]) -> (d, [Int])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (([Int] -> [Int]) -> (d, [Int]) -> (d, [Int]))
-> ([Int] -> [Int]) -> (d, [Int]) -> (d, [Int])
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
(++) ([Int] -> [Int] -> [Int]) -> [Int] -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ IntMap (Seq String) -> Expr -> [Int]
findMatchingKeys IntMap (Seq String)
im Expr
p
foldDeps DependencyType
_ Expr
_ = [(d, [Int])] -> [(d, [Int])]
forall a. a -> a
id
findMatchingKeys :: IntMap (Seq TestName) -> Expr -> [IM.Key]
findMatchingKeys :: IntMap (Seq String) -> Expr -> [Int]
findMatchingKeys IntMap (Seq String)
im Expr
pattern =
((Int, Seq String) -> [Int] -> [Int])
-> [Int] -> [(Int, Seq String)] -> [Int]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Int
k, Seq String
v) -> if Seq String -> M Bool -> Either String Bool
forall a. Seq String -> M a -> Either String a
withFields Seq String
v M Bool
pat Either String Bool -> Either String Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Either String Bool
forall a b. b -> Either a b
Right Bool
True then (Int
k Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:) else [Int] -> [Int]
forall a. a -> a
id) [] ([(Int, Seq String)] -> [Int]) -> [(Int, Seq String)] -> [Int]
forall a b. (a -> b) -> a -> b
$ IntMap (Seq String) -> [(Int, Seq String)]
forall a. IntMap a -> [(Int, a)]
IM.assocs IntMap (Seq String)
im
where
pat :: M Bool
pat = Expr -> M Value
eval Expr
pattern M Value -> (Value -> M Bool) -> M Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> M Bool
asB
#endif
postprocessResult
:: (TestName -> Maybe Result -> Result -> Result)
-> IntMap (TestName, Maybe IM.Key, TVar Status)
-> IO StatusMap
postprocessResult :: (String -> Maybe Result -> Result -> Result)
-> IntMap (String, Maybe Int, TVar Status) -> IO StatusMap
postprocessResult String -> Maybe Result -> Result -> Result
f IntMap (String, Maybe Int, TVar Status)
src = do
IntMap (String, Maybe Int, TVar Status, TVar Status)
paired <- IntMap (String, Maybe Int, TVar Status)
-> ((String, Maybe Int, TVar Status)
-> IO (String, Maybe Int, TVar Status, TVar Status))
-> IO (IntMap (String, Maybe Int, TVar Status, TVar Status))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM IntMap (String, Maybe Int, TVar Status)
src (((String, Maybe Int, TVar Status)
-> IO (String, Maybe Int, TVar Status, TVar Status))
-> IO (IntMap (String, Maybe Int, TVar Status, TVar Status)))
-> ((String, Maybe Int, TVar Status)
-> IO (String, Maybe Int, TVar Status, TVar Status))
-> IO (IntMap (String, Maybe Int, TVar Status, TVar Status))
forall a b. (a -> b) -> a -> b
$ \(String
name, Maybe Int
mDepId, TVar Status
tv) -> (String
name, Maybe Int
mDepId, TVar Status
tv,) (TVar Status -> (String, Maybe Int, TVar Status, TVar Status))
-> IO (TVar Status)
-> IO (String, Maybe Int, TVar Status, TVar Status)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Status -> IO (TVar Status)
forall a. a -> IO (TVar a)
newTVarIO Status
NotStarted
let doUpdate :: IO Bool
doUpdate = STM Bool -> IO Bool
forall a. STM a -> IO a
atomically (STM Bool -> IO Bool) -> STM Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ do
(Any Bool
anyUpdated, All Bool
allDone) <-
Ap STM (Any, All) -> STM (Any, All)
forall (f :: * -> *) a. Ap f a -> f a
getApp (Ap STM (Any, All) -> STM (Any, All))
-> Ap STM (Any, All) -> STM (Any, All)
forall a b. (a -> b) -> a -> b
$ (((String, Maybe Int, TVar Status, TVar Status)
-> Ap STM (Any, All))
-> IntMap (String, Maybe Int, TVar Status, TVar Status)
-> Ap STM (Any, All))
-> IntMap (String, Maybe Int, TVar Status, TVar Status)
-> ((String, Maybe Int, TVar Status, TVar Status)
-> Ap STM (Any, All))
-> Ap STM (Any, All)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((String, Maybe Int, TVar Status, TVar Status)
-> Ap STM (Any, All))
-> IntMap (String, Maybe Int, TVar Status, TVar Status)
-> Ap STM (Any, All)
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap IntMap (String, Maybe Int, TVar Status, TVar Status)
paired (((String, Maybe Int, TVar Status, TVar Status)
-> Ap STM (Any, All))
-> Ap STM (Any, All))
-> ((String, Maybe Int, TVar Status, TVar Status)
-> Ap STM (Any, All))
-> Ap STM (Any, All)
forall a b. (a -> b) -> a -> b
$ \(String
name, Maybe Int
mDepId, TVar Status
newTV, TVar Status
oldTV) -> STM (Any, All) -> Ap STM (Any, All)
forall (f :: * -> *) a. f a -> Ap f a
Ap (STM (Any, All) -> Ap STM (Any, All))
-> STM (Any, All) -> Ap STM (Any, All)
forall a b. (a -> b) -> a -> b
$ do
Status
old <- TVar Status -> STM Status
forall a. TVar a -> STM a
readTVar TVar Status
oldTV
case Status
old of
Done{} -> (Any, All) -> STM (Any, All)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Any
Any Bool
False, Bool -> All
All Bool
True)
Status
_ -> do
Status
new <- TVar Status -> STM Status
forall a. TVar a -> STM a
readTVar TVar Status
newTV
case Status
new of
Done Result
res -> do
Maybe Result
depRes <- case Maybe Int
mDepId Maybe Int
-> (Int -> Maybe (String, Maybe Int, TVar Status))
-> Maybe (String, Maybe Int, TVar Status)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int
-> IntMap (String, Maybe Int, TVar Status)
-> Maybe (String, Maybe Int, TVar Status)
forall a. Int -> IntMap a -> Maybe a
`IM.lookup` IntMap (String, Maybe Int, TVar Status)
src) of
Maybe (String, Maybe Int, TVar Status)
Nothing -> Maybe Result -> STM (Maybe Result)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Result
forall a. Maybe a
Nothing
Just (String
_, Maybe Int
_, TVar Status
depTV) -> do
Status
depStatus <- TVar Status -> STM Status
forall a. TVar a -> STM a
readTVar TVar Status
depTV
case Status
depStatus of
Done Result
dep -> Maybe Result -> STM (Maybe Result)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Result -> STM (Maybe Result))
-> Maybe Result -> STM (Maybe Result)
forall a b. (a -> b) -> a -> b
$ Result -> Maybe Result
forall a. a -> Maybe a
Just Result
dep
Status
_ -> Maybe Result -> STM (Maybe Result)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Result
forall a. Maybe a
Nothing
TVar Status -> Status -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar Status
oldTV (Result -> Status
Done (String -> Maybe Result -> Result -> Result
f String
name Maybe Result
depRes Result
res))
(Any, All) -> STM (Any, All)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Any
Any Bool
True, Bool -> All
All Bool
True)
Status
_ -> (Any, All) -> STM (Any, All)
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 Bool -> STM Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
allDone else STM Bool
forall a. STM a
retry
adNauseam :: IO ()
adNauseam = IO Bool
doUpdate IO Bool -> (Bool -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
`unless` IO ()
adNauseam)
ThreadId
_ <- IO () -> IO ThreadId
forkIO IO ()
adNauseam
StatusMap -> IO StatusMap
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StatusMap -> IO StatusMap) -> StatusMap -> IO StatusMap
forall a b. (a -> b) -> a -> b
$ ((String, Maybe Int, TVar Status, TVar Status) -> TVar Status)
-> IntMap (String, Maybe Int, TVar Status, TVar Status)
-> StatusMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(String
_, Maybe Int
_, TVar Status
_, TVar Status
a) -> TVar Status
a) IntMap (String, Maybe Int, TVar Status, TVar Status)
paired
word64ToDouble :: Word64 -> Double
word64ToDouble :: Word64 -> Double
word64ToDouble = Word64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral
int64ToDouble :: Int64 -> Double
int64ToDouble :: Int64 -> Double
int64ToDouble = Int64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral
word64ToInt64 :: Word64 -> Int64
word64ToInt64 :: Word64 -> Int64
word64ToInt64 = Word64 -> Int64
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