{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-- | Benchmarks for generators
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

-- | Benchmarks for both genValid
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)

-- | Benchmarks a generator with some default sizes
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]

-- | Benchmarks a generator with a given name and size
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)

-- | Benchmark for the time it takes to shrink to the first ten shrunk versions using 'shrinkValid' and a vector of 100 deterministically generated values.
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)

-- | Benchmark for the time it takes to shrink to the first ten shrunk versions using a given shrinking function and a vector of 100 deterministically generated values.
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

-- | Benchmark for the time it takes to shrink to the first ten shrunk versions using a given shrinking function and a vector of N deterministically generated values.
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

-- | Benchmark for the time it takes to shrink to the first ten shrunk versions using a given shrinking function and a given vector of values
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