{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE GADTs #-}
module Foundation.Check
( Gen
, Arbitrary(..)
, oneof
, elements
, frequency
, between
, Test(..)
, testName
, PropertyCheck
, Property(..)
, IsProperty(..)
, (===)
, propertyCompare
, propertyCompareWith
, propertyAnd
, propertyFail
, forAll
, Check
, validate
, pick
, iterateProperty
) where
import Basement.Imports
import Basement.Cast (cast)
import Basement.IntegralConv
import Basement.Types.OffsetSize
import Foundation.Check.Gen
import Foundation.Check.Arbitrary
import Foundation.Check.Property
import Foundation.Check.Types
import Foundation.Check.Print
import Foundation.Monad
import Foundation.Monad.State
import Foundation.Numerical
import Control.Exception (evaluate, SomeException)
validate :: IsProperty prop => String -> prop -> Check ()
validate :: forall prop. IsProperty prop => String -> prop -> Check ()
validate String
propertyName prop
prop = forall a. StateT PlanState IO a -> Check a
Check forall a b. (a -> b) -> a -> b
$ do
(Word64 -> GenRng
genrng, GenParams
params) <- forall (m :: * -> *) a.
MonadState m =>
(State m -> (a, State m)) -> m a
withState forall a b. (a -> b) -> a -> b
$ \State (StateT PlanState IO)
st -> ( (PlanState -> Word64 -> GenRng
planRng State (StateT PlanState IO)
st, PlanState -> GenParams
planParams State (StateT PlanState IO)
st)
, State (StateT PlanState IO)
st { planValidations :: CountOf TestResult
planValidations = PlanState -> CountOf TestResult
planValidations State (StateT PlanState IO)
st forall a. Additive a => a -> a -> a
+ CountOf TestResult
1 }
)
(PropertyResult
r,CountOf TestResult
nb) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ CountOf TestResult
-> GenParams
-> (Word64 -> GenRng)
-> Property
-> IO (PropertyResult, CountOf TestResult)
iterateProperty CountOf TestResult
100 GenParams
params Word64 -> GenRng
genrng (forall p. IsProperty p => p -> Property
property prop
prop)
case PropertyResult
r of
PropertyResult
PropertySuccess -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
PropertyFailed String
failMsg -> do
forall (m :: * -> *) a.
MonadState m =>
(State m -> (a, State m)) -> m a
withState forall a b. (a -> b) -> a -> b
$ \State (StateT PlanState IO)
st -> ((), State (StateT PlanState IO)
st { planFailures :: [TestResult]
planFailures = String -> CountOf TestResult -> PropertyResult -> TestResult
PropertyResult String
propertyName CountOf TestResult
nb (String -> PropertyResult
PropertyFailed String
failMsg) forall a. a -> [a] -> [a]
: PlanState -> [TestResult]
planFailures State (StateT PlanState IO)
st })
forall (m :: * -> *) a. Monad m => a -> m a
return ()
pick :: String -> IO a -> Check a
pick :: forall a. String -> IO a -> Check a
pick String
_ IO a
io = forall a. StateT PlanState IO a -> Check a
Check forall a b. (a -> b) -> a -> b
$ do
a
r <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
io
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
r
iterateProperty :: CountOf TestResult -> GenParams -> (Word64 -> GenRng) -> Property -> IO (PropertyResult, CountOf TestResult)
iterateProperty :: CountOf TestResult
-> GenParams
-> (Word64 -> GenRng)
-> Property
-> IO (PropertyResult, CountOf TestResult)
iterateProperty CountOf TestResult
limit GenParams
genParams Word64 -> GenRng
genRngIter Property
prop = CountOf TestResult -> IO (PropertyResult, CountOf TestResult)
iterProp CountOf TestResult
1
where
iterProp :: CountOf TestResult -> IO (PropertyResult, CountOf TestResult)
iterProp !CountOf TestResult
iter
| CountOf TestResult
iter forall a. Eq a => a -> a -> Bool
== CountOf TestResult
limit = forall (m :: * -> *) a. Monad m => a -> m a
return (PropertyResult
PropertySuccess, CountOf TestResult
iter)
| Bool
otherwise = do
(PropertyResult, Bool)
r <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (PropertyResult, Bool)
toResult
case (PropertyResult, Bool)
r of
(PropertyFailed String
e, Bool
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return (String -> PropertyResult
PropertyFailed String
e, CountOf TestResult
iter)
(PropertyResult
PropertySuccess, Bool
cont) | Bool
cont -> CountOf TestResult -> IO (PropertyResult, CountOf TestResult)
iterProp (CountOf TestResult
iterforall a. Additive a => a -> a -> a
+CountOf TestResult
1)
| Bool
otherwise -> forall (m :: * -> *) a. Monad m => a -> m a
return (PropertyResult
PropertySuccess, CountOf TestResult
iter)
where
iterW64 :: Word64
iterW64 :: Word64
iterW64 = let (CountOf Int
iter') = CountOf TestResult
iter in forall source destination.
Cast source destination =>
source -> destination
cast (forall a b. IntegralUpsize a b => a -> b
integralUpsize Int
iter' :: Int64)
toResult :: IO (PropertyResult, Bool)
toResult :: IO (PropertyResult, Bool)
toResult = (PropertyTestArg -> (PropertyResult, Bool)
propertyToResult forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> IO a
evaluate (forall a. Gen a -> GenRng -> GenParams -> a
runGen (Property -> Gen PropertyTestArg
unProp Property
prop) (Word64 -> GenRng
genRngIter Word64
iterW64) GenParams
genParams))
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` (\(SomeException
e :: SomeException) -> forall (m :: * -> *) a. Monad m => a -> m a
return (String -> PropertyResult
PropertyFailed (forall a. Show a => a -> String
show SomeException
e), Bool
False))