{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
module Foundation.Check.Property
( Property(..)
, PropertyTestArg(..)
, IsProperty
, PropertyCheck(..)
, property
, checkHasSucceed
, checkHasFailed
, forAll
, (===)
, propertyCompare
, propertyCompareWith
, propertyAnd
, propertyFail
) where
import Basement.Imports hiding (Typeable)
import Basement.Compat.Typeable
import Foundation.Check.Gen
import Foundation.Check.Arbitrary
import Data.Typeable
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 :: PropertyCheck -> PropertyTestResult
checkHasSucceed (PropertyBoolean PropertyTestResult
b) = PropertyTestResult
b
checkHasSucceed (PropertyNamed PropertyTestResult
b String
_) = PropertyTestResult
b
checkHasSucceed (PropertyBinaryOp PropertyTestResult
b String
_ String
_ String
_) = PropertyTestResult
b
checkHasSucceed (PropertyAnd PropertyTestResult
b PropertyCheck
_ PropertyCheck
_) = PropertyTestResult
b
checkHasSucceed (PropertyFail PropertyTestResult
b String
_) = PropertyTestResult
b
checkHasFailed :: PropertyCheck -> PropertyTestResult
checkHasFailed :: PropertyCheck -> PropertyTestResult
checkHasFailed = PropertyTestResult -> PropertyTestResult
not (PropertyTestResult -> PropertyTestResult)
-> (PropertyCheck -> PropertyTestResult)
-> PropertyCheck
-> PropertyTestResult
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. PropertyCheck -> PropertyTestResult
checkHasSucceed
data PropertyTestArg = PropertyEOA PropertyCheck
| PropertyArg String PropertyTestArg
data Property = Prop { Property -> Gen PropertyTestArg
unProp :: Gen PropertyTestArg }
class IsProperty p where
property :: p -> Property
instance IsProperty Bool where
property :: PropertyTestResult -> Property
property PropertyTestResult
b = Gen PropertyTestArg -> Property
Prop (Gen PropertyTestArg -> Property)
-> Gen PropertyTestArg -> Property
forall a b. (a -> b) -> a -> b
$ PropertyTestArg -> Gen PropertyTestArg
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PropertyCheck -> PropertyTestArg
PropertyEOA (PropertyCheck -> PropertyTestArg)
-> PropertyCheck -> PropertyTestArg
forall a b. (a -> b) -> a -> b
$ PropertyTestResult -> PropertyCheck
PropertyBoolean PropertyTestResult
b)
instance IsProperty (String, Bool) where
property :: (String, PropertyTestResult) -> Property
property (String
name, PropertyTestResult
b) = Gen PropertyTestArg -> Property
Prop (Gen PropertyTestArg -> Property)
-> Gen PropertyTestArg -> Property
forall a b. (a -> b) -> a -> b
$ PropertyTestArg -> Gen PropertyTestArg
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PropertyCheck -> PropertyTestArg
PropertyEOA (PropertyCheck -> PropertyTestArg)
-> PropertyCheck -> PropertyTestArg
forall a b. (a -> b) -> a -> b
$ PropertyTestResult -> String -> PropertyCheck
PropertyNamed PropertyTestResult
b String
name)
instance IsProperty PropertyCheck where
property :: PropertyCheck -> Property
property PropertyCheck
check = Gen PropertyTestArg -> Property
Prop (Gen PropertyTestArg -> Property)
-> Gen PropertyTestArg -> Property
forall a b. (a -> b) -> a -> b
$ PropertyTestArg -> Gen PropertyTestArg
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PropertyCheck -> PropertyTestArg
PropertyEOA PropertyCheck
check)
instance IsProperty Property where
property :: Property -> Property
property Property
p = Property
p
instance (Show a, Arbitrary a, IsProperty prop) => IsProperty (a -> prop) where
property :: (a -> prop) -> Property
property a -> prop
p = Gen a -> (a -> prop) -> Property
forall a prop.
(Show a, IsProperty prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen a
forall a. Arbitrary a => Gen a
arbitrary a -> prop
p
forAll :: (Show a, IsProperty prop) => Gen a -> (a -> prop) -> Property
forAll :: Gen a -> (a -> prop) -> Property
forAll Gen a
generator a -> prop
tst = Gen PropertyTestArg -> Property
Prop (Gen PropertyTestArg -> Property)
-> Gen PropertyTestArg -> Property
forall a b. (a -> b) -> a -> b
$ do
a
a <- Gen a
generator
a -> PropertyTestArg -> PropertyTestArg
forall a. Show a => a -> PropertyTestArg -> PropertyTestArg
augment a
a (PropertyTestArg -> PropertyTestArg)
-> Gen PropertyTestArg -> Gen PropertyTestArg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Property -> Gen PropertyTestArg
unProp (prop -> Property
forall p. IsProperty p => p -> Property
property (a -> prop
tst a
a))
where
augment :: a -> PropertyTestArg -> PropertyTestArg
augment a
a PropertyTestArg
arg = String -> PropertyTestArg -> PropertyTestArg
PropertyArg (a -> String
forall a. Show a => a -> String
show a
a) PropertyTestArg
arg
(===) :: (Show a, Eq a, Typeable a) => a -> a -> PropertyCheck
=== :: a -> a -> PropertyCheck
(===) a
a a
b =
let sa :: String
sa = a -> Proxy a -> String
forall a. (Show a, Typeable a) => a -> Proxy a -> String
pretty a
a Proxy a
forall k (t :: k). Proxy t
Proxy
sb :: String
sb = a -> Proxy a -> String
forall a. (Show a, Typeable a) => a -> Proxy a -> String
pretty a
b Proxy a
forall k (t :: k). Proxy t
Proxy
in PropertyTestResult -> String -> String -> String -> PropertyCheck
PropertyBinaryOp (a
a a -> a -> PropertyTestResult
forall a. Eq a => a -> a -> PropertyTestResult
== a
b) String
"==" String
sa String
sb
infix 4 ===
pretty :: (Show a, Typeable a) => a -> Proxy a -> String
pretty :: a -> Proxy a -> String
pretty a
a Proxy a
pa = a -> String
forall a. Show a => a -> String
show a
a String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" :: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> TypeRep -> String
forall a. Show a => a -> String
show (Proxy a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy a
pa)
propertyCompare :: (Show a, Typeable a)
=> String
-> (a -> a -> Bool)
-> a
-> a
-> PropertyCheck
propertyCompare :: String -> (a -> a -> PropertyTestResult) -> a -> a -> PropertyCheck
propertyCompare String
name a -> a -> PropertyTestResult
op = String
-> (a -> a -> PropertyTestResult)
-> (a -> String)
-> a
-> a
-> PropertyCheck
forall a.
String
-> (a -> a -> PropertyTestResult)
-> (a -> String)
-> a
-> a
-> PropertyCheck
propertyCompareWith String
name a -> a -> PropertyTestResult
op ((a -> Proxy a -> String) -> Proxy a -> a -> String
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> Proxy a -> String
forall a. (Show a, Typeable a) => a -> Proxy a -> String
pretty Proxy a
forall k (t :: k). Proxy t
Proxy)
propertyCompareWith :: String
-> (a -> a -> Bool)
-> (a -> String)
-> a
-> a
-> PropertyCheck
propertyCompareWith :: String
-> (a -> a -> PropertyTestResult)
-> (a -> String)
-> a
-> a
-> PropertyCheck
propertyCompareWith String
name a -> a -> PropertyTestResult
op a -> String
display a
a a
b =
let sa :: String
sa = a -> String
display a
a
sb :: String
sb = a -> String
display a
b
in PropertyTestResult -> String -> String -> String -> PropertyCheck
PropertyBinaryOp (a
a a -> a -> PropertyTestResult
`op` a
b) String
name String
sa String
sb
propertyAnd :: PropertyCheck -> PropertyCheck -> PropertyCheck
propertyAnd :: PropertyCheck -> PropertyCheck -> PropertyCheck
propertyAnd PropertyCheck
c1 PropertyCheck
c2 =
PropertyTestResult
-> PropertyCheck -> PropertyCheck -> PropertyCheck
PropertyAnd (PropertyCheck -> PropertyTestResult
checkHasSucceed PropertyCheck
c1 PropertyTestResult -> PropertyTestResult -> PropertyTestResult
&& PropertyCheck -> PropertyTestResult
checkHasSucceed PropertyCheck
c2) PropertyCheck
c1 PropertyCheck
c2
propertyFail :: String -> PropertyCheck
propertyFail :: String -> PropertyCheck
propertyFail = PropertyTestResult -> String -> PropertyCheck
PropertyFail PropertyTestResult
False