{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Data.GenValidity.Criterion
( genValidityBench,
genUncheckedBench,
genValidBench,
genBenchSizes,
genBench,
genBenchSized,
)
where
import Control.DeepSeq
import Criterion
import Data.GenValidity
import Test.QuickCheck.Gen
import Test.QuickCheck.Random
import Data.Typeable
genValidityBench ::
forall a.
(Typeable a, NFData a, GenUnchecked a, GenValid a) =>
Benchmark
genValidityBench =
bgroup (unwords ["GenValidity", nameOf @a]) [genValidBench @a, genUncheckedBench @a]
genUncheckedBench ::
forall a.
(Typeable a, NFData a, GenUnchecked a) =>
Benchmark
genUncheckedBench = genBenchSizes (unwords ["genUnchecked", nameOf @a]) (genUnchecked @a)
genValidBench ::
forall a.
(Typeable a, NFData a, GenValid a) =>
Benchmark
genValidBench = genBenchSizes (unwords ["genValid", nameOf @a]) (genValid @a)
genBenchSizes :: NFData a => String -> Gen a -> Benchmark
genBenchSizes name gen =
bgroup name $
let bi i = genBenchSized ("size " <> show i) i gen
in [bi 15, bi 30]
genBench :: NFData a => String -> Gen a -> Benchmark
genBench name = genBenchSized name 30
genBenchSized :: NFData a => String -> Int -> Gen a -> Benchmark
genBenchSized name size (MkGen genFunc) =
bench name $ nf (\seed -> genFunc seed size) (mkQCGen 42)
nameOf ::
forall a.
Typeable a =>
String
nameOf =
let s = show $ typeRep (Proxy @a)
in if ' ' `elem` s
then "(" ++ s ++ ")"
else s