{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Data.GenValidity.Criterion
( genValidBench,
genBench,
genBenchSized,
shrinkValidBench,
shrinkBench,
shrinkBenchN,
shrinkBenchVector,
)
where
import Control.DeepSeq
import Criterion
import Data.GenValidity
import Data.Typeable
import Data.Vector (Vector)
import qualified Data.Vector as V
import Test.QuickCheck.Gen
import Test.QuickCheck.Random
genValidBench ::
forall a.
(Typeable a, NFData a, GenValid a) =>
Benchmark
genValidBench :: forall a. (Typeable a, NFData a, GenValid a) => Benchmark
genValidBench = forall a. NFData a => String -> Gen a -> Benchmark
genBench ([String] -> String
unwords [String
"genValid", forall a. Typeable a => String
nameOf @a]) (forall a. GenValid a => Gen a
genValid @a)
genBench :: NFData a => String -> Gen a -> Benchmark
genBench :: forall a. NFData a => String -> Gen a -> Benchmark
genBench String
name Gen a
gen =
String -> [Benchmark] -> Benchmark
bgroup String
name forall a b. (a -> b) -> a -> b
$
let bi :: Int -> Benchmark
bi Int
i = forall a. NFData a => String -> Int -> Gen a -> Benchmark
genBenchSized (String
"size " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
i) Int
i Gen a
gen
in [Int -> Benchmark
bi Int
15, Int -> Benchmark
bi Int
30]
genBenchSized :: NFData a => String -> Int -> Gen a -> Benchmark
genBenchSized :: forall a. NFData a => String -> Int -> Gen a -> Benchmark
genBenchSized String
name Int
size Gen a
gen =
let MkGen QCGen -> Int -> Vector a
genFunc = forall (m :: * -> *) a. Monad m => Int -> m a -> m (Vector a)
V.replicateM Int
100 Gen a
gen
in String -> Benchmarkable -> Benchmark
bench String
name forall a b. (a -> b) -> a -> b
$ forall b a. NFData b => (a -> b) -> a -> Benchmarkable
nf (\QCGen
seed -> QCGen -> Int -> Vector a
genFunc QCGen
seed Int
size) (Int -> QCGen
mkQCGen Int
42)
shrinkValidBench ::
forall a.
(Typeable a, NFData a, GenValid a) =>
Benchmark
shrinkValidBench :: forall a. (Typeable a, NFData a, GenValid a) => Benchmark
shrinkValidBench =
forall a.
(GenValid a, NFData a) =>
String -> (a -> [a]) -> Benchmark
shrinkBench
([String] -> String
unwords [String
"shrinkValid", forall a. Typeable a => String
nameOf @a])
(forall a. GenValid a => a -> [a]
shrinkValid @a)
shrinkBench :: (GenValid a, NFData a) => String -> (a -> [a]) -> Benchmark
shrinkBench :: forall a.
(GenValid a, NFData a) =>
String -> (a -> [a]) -> Benchmark
shrinkBench = forall a.
(GenValid a, NFData a) =>
Int -> String -> (a -> [a]) -> Benchmark
shrinkBenchN Int
100
shrinkBenchN :: forall a. (GenValid a, NFData a) => Int -> String -> (a -> [a]) -> Benchmark
shrinkBenchN :: forall a.
(GenValid a, NFData a) =>
Int -> String -> (a -> [a]) -> Benchmark
shrinkBenchN Int
n String
name a -> [a]
shrinker =
forall arg.
(NFData arg, GenValid arg) =>
Int -> (Vector arg -> Benchmark) -> Benchmark
withArgs Int
n forall a b. (a -> b) -> a -> b
$ \Vector a
args -> forall a. NFData a => Vector a -> String -> (a -> [a]) -> Benchmark
shrinkBenchVector Vector a
args String
name a -> [a]
shrinker
shrinkBenchVector :: forall a. NFData a => Vector a -> String -> (a -> [a]) -> Benchmark
shrinkBenchVector :: forall a. NFData a => Vector a -> String -> (a -> [a]) -> Benchmark
shrinkBenchVector Vector a
args String
name a -> [a]
shrinker =
String -> Benchmarkable -> Benchmark
bench
String
name
(forall b a. NFData b => (a -> b) -> a -> Benchmarkable
nf (forall a b. (a -> b) -> Vector a -> Vector b
V.map (forall a. Int -> [a] -> [a]
take Int
10 forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [a]
shrinker)) (Vector a
args :: Vector a))
withArgs :: (NFData arg, GenValid arg) => Int -> (Vector arg -> Benchmark) -> Benchmark
withArgs :: forall arg.
(NFData arg, GenValid arg) =>
Int -> (Vector arg -> Benchmark) -> Benchmark
withArgs Int
n = forall env. NFData env => IO env -> (env -> Benchmark) -> Benchmark
env (forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Gen a -> a
generateDeterministically forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => Int -> m a -> m (Vector a)
V.replicateM Int
n forall a. GenValid a => Gen a
genValid))
generateDeterministically :: Gen a -> a
generateDeterministically :: forall a. Gen a -> a
generateDeterministically (MkGen QCGen -> Int -> a
f) = QCGen -> Int -> a
f QCGen
seed Int
size
where
seed :: QCGen
seed = Int -> QCGen
mkQCGen Int
42
size :: Int
size = Int
30
nameOf ::
forall a.
Typeable a =>
String
nameOf :: forall a. Typeable a => String
nameOf =
let s :: String
s = forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall {k} (t :: k). Proxy t
Proxy @a)
in if Char
' ' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
s
then String
"(" forall a. [a] -> [a] -> [a]
++ String
s forall a. [a] -> [a] -> [a]
++ String
")"
else String
s