{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE AllowAmbiguousTypes #-}

-- | Eq properties
--
-- You will need @TypeApplications@ to use these.
module Test.Syd.Validity.Eq
    ( eqSpecOnValid
    , eqSpecOnInvalid
    , eqSpec
    , eqSpecOnArbitrary
    , eqSpecOnGen
    ) where

import Data.Data

import Data.GenValidity

import Test.Syd
import Test.QuickCheck

import Test.Syd.Validity.Functions
import Test.Syd.Validity.Relations
import Test.Syd.Validity.Utils

eqTypeStr ::
       forall a. Typeable a
    => String
eqTypeStr :: String
eqTypeStr = String -> String
forall k (a :: k). Typeable a => String -> String
binRelStr @a String
"=="

neqTypeStr ::
       forall a. Typeable a
    => String
neqTypeStr :: String
neqTypeStr = String -> String
forall k (a :: k). Typeable a => String -> String
binRelStr @a String
"/="

-- | Standard test spec for properties of Eq instances for valid values
--
-- Example usage:
--
-- > eqSpecOnValid @Double
eqSpecOnValid ::
       forall a. (Show a, Eq a, Typeable a, GenValid a)
    => Spec
eqSpecOnValid :: Spec
eqSpecOnValid = Gen a -> String -> (a -> [a]) -> Spec
forall a.
(Show a, Eq a, Typeable a) =>
Gen a -> String -> (a -> [a]) -> Spec
eqSpecOnGen @a Gen a
forall a. GenValid a => Gen a
genValid String
"valid" a -> [a]
forall a. GenValid a => a -> [a]
shrinkValid

-- | Standard test spec for properties of Eq instances for invalid values
--
-- Example usage:
--
-- > eqSpecOnInvalid @Double
eqSpecOnInvalid ::
       forall a. (Show a, Eq a, Typeable a, GenInvalid a)
    => Spec
eqSpecOnInvalid :: Spec
eqSpecOnInvalid = Gen a -> String -> (a -> [a]) -> Spec
forall a.
(Show a, Eq a, Typeable a) =>
Gen a -> String -> (a -> [a]) -> Spec
eqSpecOnGen @a Gen a
forall a. GenInvalid a => Gen a
genInvalid String
"invalid" a -> [a]
forall a. GenInvalid a => a -> [a]
shrinkInvalid

-- | Standard test spec for properties of Eq instances for unchecked values
--
-- Example usage:
--
-- > eqSpec @Int
eqSpec ::
       forall a. (Show a, Eq a, Typeable a, GenUnchecked a)
    => Spec
eqSpec :: Spec
eqSpec = Gen a -> String -> (a -> [a]) -> Spec
forall a.
(Show a, Eq a, Typeable a) =>
Gen a -> String -> (a -> [a]) -> Spec
eqSpecOnGen @a Gen a
forall a. GenUnchecked a => Gen a
genUnchecked String
"unchecked" a -> [a]
forall a. GenUnchecked a => a -> [a]
shrinkUnchecked

-- | Standard test spec for properties of Eq instances for arbitrary values
--
-- Example usage:
--
-- > eqSpecOnArbitrary @Int
eqSpecOnArbitrary ::
       forall a. (Show a, Eq a, Typeable a, Arbitrary a)
    => Spec
eqSpecOnArbitrary :: Spec
eqSpecOnArbitrary = Gen a -> String -> (a -> [a]) -> Spec
forall a.
(Show a, Eq a, Typeable a) =>
Gen a -> String -> (a -> [a]) -> Spec
eqSpecOnGen @a Gen a
forall a. Arbitrary a => Gen a
arbitrary String
"arbitrary" a -> [a]
forall a. Arbitrary a => a -> [a]
shrink

-- | Standard test spec for properties of Eq instances for values generated by a given generator (and name for that generator).
--
-- Example usage:
--
-- > eqSpecOnGen ((* 2) <$> genValid @Int) "even"
eqSpecOnGen ::
       forall a. (Show a, Eq a, Typeable a)
    => Gen a
    -> String
    -> (a -> [a])
    -> Spec
eqSpecOnGen :: Gen a -> String -> (a -> [a]) -> Spec
eqSpecOnGen Gen a
gen String
genname a -> [a]
s =
    Spec -> Spec
forall (a :: [*]) b c. TestDefM a b c -> TestDefM a b c
parallel (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
        let name :: String
name = Typeable a => String
forall k (a :: k). Typeable a => String
nameOf @a
            funeqstr :: String
funeqstr = Typeable a => String
forall a. Typeable a => String
eqTypeStr @a
            funneqstr :: String
funneqstr = Typeable a => String
forall a. Typeable a => String
neqTypeStr @a
            gen2 :: Gen (a, a)
gen2 = (,) (a -> a -> (a, a)) -> Gen a -> Gen (a -> (a, a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
gen Gen (a -> (a, a)) -> Gen a -> Gen (a, a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen a
gen
            gen3 :: Gen (a, a, a)
gen3 = (,,) (a -> a -> a -> (a, a, a)) -> Gen a -> Gen (a -> a -> (a, a, a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
gen Gen (a -> a -> (a, a, a)) -> Gen a -> Gen (a -> (a, a, a))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen a
gen Gen (a -> (a, a, a)) -> Gen a -> Gen (a, a, a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen a
gen
            s2 :: (a, a) -> [(a, a)]
s2 = (a -> [a]) -> (a, a) -> [(a, a)]
forall a. (a -> [a]) -> (a, a) -> [(a, a)]
shrinkT2 a -> [a]
s
        String -> Spec -> Spec
forall (outers :: [*]) inner.
String -> TestDefM outers inner () -> TestDefM outers inner ()
describe (String
"Eq " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name) (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
            let eq :: a -> a -> Bool
eq = Eq a => a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==) @a
                neq :: a -> a -> Bool
neq = Eq a => a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(/=) @a
            String -> Spec -> Spec
forall (outers :: [*]) inner.
String -> TestDefM outers inner () -> TestDefM outers inner ()
describe String
funeqstr (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
                String -> Property -> Spec
forall (outers :: [*]) inner test.
(HasCallStack, IsTest test, Arg1 test ~ (), Arg2 test ~ inner) =>
String -> test -> TestDefM outers inner ()
it
                    ([String] -> String
unwords
                         [ String
"is reflexive for"
                         , String
"\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
genname
                         , String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"s"
                         ]) (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
                    (a -> a -> Bool) -> Gen a -> (a -> [a]) -> Property
forall a.
Show a =>
(a -> a -> Bool) -> Gen a -> (a -> [a]) -> Property
reflexivityOnGen a -> a -> Bool
eq Gen a
gen a -> [a]
s
                String -> Property -> Spec
forall (outers :: [*]) inner test.
(HasCallStack, IsTest test, Arg1 test ~ (), Arg2 test ~ inner) =>
String -> test -> TestDefM outers inner ()
it
                    ([String] -> String
unwords
                         [ String
"is symmetric for"
                         , String
"\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
genname
                         , String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"s"
                         ]) (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
                    (a -> a -> Bool) -> Gen (a, a) -> (a -> [a]) -> Property
forall a.
Show a =>
(a -> a -> Bool) -> Gen (a, a) -> (a -> [a]) -> Property
symmetryOnGens a -> a -> Bool
eq Gen (a, a)
gen2 a -> [a]
s
                String -> Property -> Spec
forall (outers :: [*]) inner test.
(HasCallStack, IsTest test, Arg1 test ~ (), Arg2 test ~ inner) =>
String -> test -> TestDefM outers inner ()
it
                    ([String] -> String
unwords
                         [ String
"is transitive for"
                         , String
"\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
genname
                         , String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"s"
                         ]) (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
                    (a -> a -> Bool) -> Gen (a, a, a) -> (a -> [a]) -> Property
forall a.
Show a =>
(a -> a -> Bool) -> Gen (a, a, a) -> (a -> [a]) -> Property
transitivityOnGens a -> a -> Bool
eq Gen (a, a, a)
gen3 a -> [a]
s
                String -> Property -> Spec
forall (outers :: [*]) inner test.
(HasCallStack, IsTest test, Arg1 test ~ (), Arg2 test ~ inner) =>
String -> test -> TestDefM outers inner ()
it
                    ([String] -> String
unwords
                         [ String
"is equivalent to (\\a b -> not $ a /= b) for"
                         , String
"\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
genname
                         , String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"s"
                         ]) (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
                    (a -> a -> Bool)
-> (a -> a -> Bool)
-> Gen (a, a)
-> ((a, a) -> [(a, a)])
-> Property
forall a b c.
(Show a, Show b, Show c, Eq c) =>
(a -> b -> c)
-> (a -> b -> c) -> Gen (a, b) -> ((a, b) -> [(a, b)]) -> Property
equivalentOnGens2 a -> a -> Bool
eq (\a
a a
b -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ a
a a -> a -> Bool
`neq` a
b) Gen (a, a)
gen2 (a, a) -> [(a, a)]
s2
            String -> Spec -> Spec
forall (outers :: [*]) inner.
String -> TestDefM outers inner () -> TestDefM outers inner ()
describe String
funneqstr (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
                String -> Property -> Spec
forall (outers :: [*]) inner test.
(HasCallStack, IsTest test, Arg1 test ~ (), Arg2 test ~ inner) =>
String -> test -> TestDefM outers inner ()
it
                    ([String] -> String
unwords
                         [ String
"is antireflexive for"
                         , String
"\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
genname
                         , String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"s"
                         ]) (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
                    (a -> a -> Bool) -> Gen a -> (a -> [a]) -> Property
forall a.
Show a =>
(a -> a -> Bool) -> Gen a -> (a -> [a]) -> Property
antireflexivityOnGen a -> a -> Bool
neq Gen a
gen a -> [a]
s
                String -> Property -> Spec
forall (outers :: [*]) inner test.
(HasCallStack, IsTest test, Arg1 test ~ (), Arg2 test ~ inner) =>
String -> test -> TestDefM outers inner ()
it
                    ([String] -> String
unwords
                         [ String
"is equivalent to (\\a b -> not $ a == b) for"
                         , String
"\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
genname
                         , String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"s"
                         ]) (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
                    (a -> a -> Bool)
-> (a -> a -> Bool)
-> Gen (a, a)
-> ((a, a) -> [(a, a)])
-> Property
forall a b c.
(Show a, Show b, Show c, Eq c) =>
(a -> b -> c)
-> (a -> b -> c) -> Gen (a, b) -> ((a, b) -> [(a, b)]) -> Property
equivalentOnGens2 a -> a -> Bool
neq (\a
a a
b -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ a
a a -> a -> Bool
`eq` a
b) Gen (a, a)
gen2 (a, a) -> [(a, a)]
s2