{-# 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 :: String -> prop -> Check ()
validate String
propertyName prop
prop = StateT PlanState IO () -> Check ()
forall a. StateT PlanState IO a -> Check a
Check (StateT PlanState IO () -> Check ())
-> StateT PlanState IO () -> Check ()
forall a b. (a -> b) -> a -> b
$ do
(Word64 -> GenRng
genrng, GenParams
params) <- (State (StateT PlanState IO)
-> ((Word64 -> GenRng, GenParams), State (StateT PlanState IO)))
-> StateT PlanState IO (Word64 -> GenRng, GenParams)
forall (m :: * -> *) a.
MonadState m =>
(State m -> (a, State m)) -> m a
withState ((State (StateT PlanState IO)
-> ((Word64 -> GenRng, GenParams), State (StateT PlanState IO)))
-> StateT PlanState IO (Word64 -> GenRng, GenParams))
-> (State (StateT PlanState IO)
-> ((Word64 -> GenRng, GenParams), State (StateT PlanState IO)))
-> StateT PlanState IO (Word64 -> GenRng, GenParams)
forall a b. (a -> b) -> a -> b
$ \State (StateT PlanState IO)
st -> ( (PlanState -> Word64 -> GenRng
planRng State (StateT PlanState IO)
PlanState
st, PlanState -> GenParams
planParams State (StateT PlanState IO)
PlanState
st)
, State (StateT PlanState IO)
PlanState
st { planValidations :: CountOf TestResult
planValidations = PlanState -> CountOf TestResult
planValidations State (StateT PlanState IO)
PlanState
st CountOf TestResult -> CountOf TestResult -> CountOf TestResult
forall a. Additive a => a -> a -> a
+ CountOf TestResult
1 }
)
(PropertyResult
r,CountOf TestResult
nb) <- IO (PropertyResult, CountOf TestResult)
-> StateT PlanState IO (PropertyResult, CountOf TestResult)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (PropertyResult, CountOf TestResult)
-> StateT PlanState IO (PropertyResult, CountOf TestResult))
-> IO (PropertyResult, CountOf TestResult)
-> StateT PlanState IO (PropertyResult, CountOf TestResult)
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 (prop -> Property
forall p. IsProperty p => p -> Property
property prop
prop)
case PropertyResult
r of
PropertyResult
PropertySuccess -> () -> StateT PlanState IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
PropertyFailed String
failMsg -> do
(State (StateT PlanState IO) -> ((), State (StateT PlanState IO)))
-> StateT PlanState IO ()
forall (m :: * -> *) a.
MonadState m =>
(State m -> (a, State m)) -> m a
withState ((State (StateT PlanState IO) -> ((), State (StateT PlanState IO)))
-> StateT PlanState IO ())
-> (State (StateT PlanState IO)
-> ((), State (StateT PlanState IO)))
-> StateT PlanState IO ()
forall a b. (a -> b) -> a -> b
$ \State (StateT PlanState IO)
st -> ((), State (StateT PlanState IO)
PlanState
st { planFailures :: [TestResult]
planFailures = String -> CountOf TestResult -> PropertyResult -> TestResult
PropertyResult String
propertyName CountOf TestResult
nb (String -> PropertyResult
PropertyFailed String
failMsg) TestResult -> [TestResult] -> [TestResult]
forall a. a -> [a] -> [a]
: PlanState -> [TestResult]
planFailures State (StateT PlanState IO)
PlanState
st })
() -> StateT PlanState IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
pick :: String -> IO a -> Check a
pick :: String -> IO a -> Check a
pick String
_ IO a
io = StateT PlanState IO a -> Check a
forall a. StateT PlanState IO a -> Check a
Check (StateT PlanState IO a -> Check a)
-> StateT PlanState IO a -> Check a
forall a b. (a -> b) -> a -> b
$ do
a
r <- IO a -> StateT PlanState IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
io
a -> StateT PlanState IO a
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 CountOf TestResult -> CountOf TestResult -> Bool
forall a. Eq a => a -> a -> Bool
== CountOf TestResult
limit = (PropertyResult, CountOf TestResult)
-> IO (PropertyResult, CountOf TestResult)
forall (m :: * -> *) a. Monad m => a -> m a
return (PropertyResult
PropertySuccess, CountOf TestResult
iter)
| Bool
otherwise = do
(PropertyResult, Bool)
r <- IO (PropertyResult, Bool) -> IO (PropertyResult, Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (PropertyResult, Bool)
toResult
case (PropertyResult, Bool)
r of
(PropertyFailed String
e, Bool
_) -> (PropertyResult, CountOf TestResult)
-> IO (PropertyResult, CountOf TestResult)
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
iterCountOf TestResult -> CountOf TestResult -> CountOf TestResult
forall a. Additive a => a -> a -> a
+CountOf TestResult
1)
| Bool
otherwise -> (PropertyResult, CountOf TestResult)
-> IO (PropertyResult, CountOf TestResult)
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 Int64 -> Word64
forall source destination.
Cast source destination =>
source -> destination
cast (Int -> Int64
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 (PropertyTestArg -> (PropertyResult, Bool))
-> IO PropertyTestArg -> IO (PropertyResult, Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PropertyTestArg -> IO PropertyTestArg
forall a. a -> IO a
evaluate (Gen PropertyTestArg -> GenRng -> GenParams -> PropertyTestArg
forall a. Gen a -> GenRng -> GenParams -> a
runGen (Property -> Gen PropertyTestArg
unProp Property
prop) (Word64 -> GenRng
genRngIter Word64
iterW64) GenParams
genParams))
IO (PropertyResult, Bool)
-> (SomeException -> IO (PropertyResult, Bool))
-> IO (PropertyResult, Bool)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` (\(SomeException
e :: SomeException) -> (PropertyResult, Bool) -> IO (PropertyResult, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> PropertyResult
PropertyFailed (SomeException -> String
forall a. Show a => a -> String
show SomeException
e), Bool
False))