1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
|
{-# LANGUAGE LambdaCase #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module VerifyBindings where
import Control.Applicative
import Hedgehog
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import Test.Tasty
import Test.Tasty.Hedgehog.Alt
import qualified Test.Verification as V
verifyGenerators :: V.GenEnv Gen
verifyGenerators = V.GenEnv { V.genChooseBool = Gen.bool
, V.genChooseInteger = \r -> Gen.integral (uncurry Range.linear r)
, V.genChooseInt = \r -> Gen.int (uncurry Range.linear r)
, V.genGetSize = Gen.sized (\s -> return $ unSize s)
}
genTest :: String -> V.Gen V.Property -> TestTree
genTest nm p = testProperty nm $ property $ mkProp =<< (forAll $ V.toNativeProperty verifyGenerators p)
where mkProp (V.BoolProperty b) = test $ assert b
mkProp (V.AssumptionProp a) = if (V.preCondition a) then (mkProp $ V.assumedProp a) else discard
setTestOptions :: TestTree -> TestTree
setTestOptions =
-- some tests discard a lot of values based on preconditions;
-- this helps prevent those tests from failing for insufficent coverage
localOption (HedgehogDiscardLimit (Just 500000)) .
-- run at least 5000 tests
adjustOption (\(HedgehogTestLimit x) -> HedgehogTestLimit (max 5000 <$> x <|> Just 5000))
|
