module Foundation.Check.Property
( Property(..)
, PropertyTestArg(..)
, IsProperty
, PropertyCheck(..)
, property
, checkHasSucceed
, checkHasFailed
, forAll
, (===)
, propertyCompare
, propertyAnd
, propertyFail
) where
import Foundation.Internal.Base
import Foundation.Check.Gen
import Foundation.Check.Arbitrary
import Foundation.String
type PropertyTestResult = Bool
data PropertyCheck = PropertyBoolean PropertyTestResult
| PropertyNamed PropertyTestResult String
| PropertyBinaryOp PropertyTestResult String String String
| PropertyAnd PropertyTestResult PropertyCheck PropertyCheck
| PropertyFail PropertyTestResult String
checkHasSucceed :: PropertyCheck -> PropertyTestResult
checkHasSucceed (PropertyBoolean b) = b
checkHasSucceed (PropertyNamed b _) = b
checkHasSucceed (PropertyBinaryOp b _ _ _) = b
checkHasSucceed (PropertyAnd b _ _) = b
checkHasSucceed (PropertyFail b _) = b
checkHasFailed :: PropertyCheck -> PropertyTestResult
checkHasFailed = not . checkHasSucceed
data PropertyTestArg = PropertyEOA PropertyCheck
| PropertyArg String PropertyTestArg
data Property = Prop { unProp :: Gen PropertyTestArg }
class IsProperty p where
property :: p -> Property
instance IsProperty Bool where
property b = Prop $ pure (PropertyEOA $ PropertyBoolean b)
instance IsProperty (String, Bool) where
property (name, b) = Prop $ pure (PropertyEOA $ PropertyNamed b name)
instance IsProperty PropertyCheck where
property check = Prop $ pure (PropertyEOA check)
instance IsProperty Property where
property p = p
instance (Show a, Arbitrary a, IsProperty prop) => IsProperty (a -> prop) where
property p = forAll arbitrary p
forAll :: (Show a, IsProperty prop) => Gen a -> (a -> prop) -> Property
forAll generator tst = Prop $ do
a <- generator
augment a <$> unProp (property (tst a))
where
augment a arg = PropertyArg (fromList $ show a) arg
(===) :: (Show a, Eq a) => a -> a -> PropertyCheck
(===) a b =
let sa = fromList (show a)
sb = fromList (show b)
in PropertyBinaryOp (a == b) "==" sa sb
infix 4 ===
propertyCompare :: Show a
=> String
-> (a -> a -> Bool)
-> a
-> a
-> PropertyCheck
propertyCompare name op a b =
let sa = fromList (show a)
sb = fromList (show b)
in PropertyBinaryOp (a `op` b) name sa sb
propertyAnd :: PropertyCheck -> PropertyCheck -> PropertyCheck
propertyAnd c1 c2 =
PropertyAnd (checkHasSucceed c1 && checkHasSucceed c2) c1 c2
propertyFail :: String -> PropertyCheck
propertyFail = PropertyFail False