{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
module Foundation.Check.Property
    ( Property(..)
    , PropertyTestArg(..)
    , IsProperty
    , PropertyCheck(..)
    , property
    , checkHasSucceed
    , checkHasFailed
    -- * Properties
    , 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

-- | The type of check this test did for a property
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

-- | A linked-list of arguments to this test
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

-- | Running a generator for a specific type under a property
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

-- | A property that check for equality of its 2 members.
(===) :: (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)

-- | A property that check for a specific comparaison of its 2 members.
--
-- This is equivalent to `===` but with `compare`
propertyCompare :: (Show a, Typeable a)
                => String           -- ^ name of the function used for comparaison, e.g. (<)
                -> (a -> a -> Bool) -- ^ function used for value comparaison
                -> a                -- ^ value left of the operator
                -> a                -- ^ value right of the operator
                -> 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)

-- | A property that check for a specific comparaison of its 2 members.
--
-- This is equivalent to `===` but with `compare` and a given method to
-- pretty print the values.
--
propertyCompareWith :: String           -- ^ name of the function used for comparaison, e.g. (<)
                    -> (a -> a -> Bool) -- ^ function used for value comparaison
                    -> (a -> String)    -- ^ function used to pretty print the values
                    -> a                -- ^ value left of the operator
                    -> a                -- ^ value right of the operator
                    -> 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

-- | A conjuctive property composed of 2 properties that need to pass
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