{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Test.Syd.Validity.Relations.Symmetry
    ( symmetricOnElems
    , symmetryOnGens
    , symmetryOnValid
    , symmetry
    , symmetryOnArbitrary
    ) where

import Data.GenValidity

import Test.QuickCheck

import Test.Syd.Validity.Property.Utils

-- |
--
-- \[
--   Symmetric(\prec)
--   \quad\equiv\quad
--   \forall a, b: (a \prec b) \Leftrightarrow (b \prec a)
-- \]
symmetricOnElems ::
       (a -> a -> Bool) -- ^ A relation
    -> a
    -> a -- ^ Two elements
    -> Bool
symmetricOnElems :: (a -> a -> Bool) -> a -> a -> Bool
symmetricOnElems a -> a -> Bool
func a
a a
b = a -> a -> Bool
func a
a a
b Bool -> Bool -> Bool
<==> a -> a -> Bool
func a
b a
a

symmetryOnGens ::
       Show a => (a -> a -> Bool) -> Gen (a, a) -> (a -> [a]) -> Property
symmetryOnGens :: (a -> a -> Bool) -> Gen (a, a) -> (a -> [a]) -> Property
symmetryOnGens a -> a -> Bool
func Gen (a, a)
gen a -> [a]
s =
    Gen (a, a) -> ((a, a) -> [(a, a)]) -> ((a, a) -> Bool) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
forAllShrink Gen (a, a)
gen ((a -> [a]) -> (a, a) -> [(a, a)]
forall a. (a -> [a]) -> (a, a) -> [(a, a)]
shrinkT2 a -> [a]
s) (((a, a) -> Bool) -> Property) -> ((a, a) -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ (a -> a -> Bool) -> (a, a) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((a -> a -> Bool) -> (a, a) -> Bool)
-> (a -> a -> Bool) -> (a, a) -> Bool
forall a b. (a -> b) -> a -> b
$ (a -> a -> Bool) -> a -> a -> Bool
forall a. (a -> a -> Bool) -> a -> a -> Bool
symmetricOnElems a -> a -> Bool
func

-- |
--
-- prop> symmetryOnValid ((==) :: Double -> Double -> Bool)
-- prop> symmetryOnValid ((/=) :: Double -> Double -> Bool)
symmetryOnValid :: (Show a, GenValid a) => (a -> a -> Bool) -> Property
symmetryOnValid :: (a -> a -> Bool) -> Property
symmetryOnValid a -> a -> Bool
func = (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
func Gen (a, a)
forall a. GenValid a => Gen a
genValid a -> [a]
forall a. GenValid a => a -> [a]
shrinkValid

-- |
--
-- prop> symmetry ((==) :: Int -> Int -> Bool)
-- prop> symmetry ((/=) :: Int -> Int -> Bool)
symmetry :: (Show a, GenUnchecked a) => (a -> a -> Bool) -> Property
symmetry :: (a -> a -> Bool) -> Property
symmetry a -> a -> Bool
func = (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
func Gen (a, a)
forall a. GenUnchecked a => Gen a
genUnchecked a -> [a]
forall a. GenUnchecked a => a -> [a]
shrinkUnchecked

-- |
--
-- prop> symmetryOnArbitrary ((==) :: Int -> Int -> Bool)
-- prop> symmetryOnArbitrary ((/=) :: Int -> Int -> Bool)
symmetryOnArbitrary :: (Show a, Arbitrary a) => (a -> a -> Bool) -> Property
symmetryOnArbitrary :: (a -> a -> Bool) -> Property
symmetryOnArbitrary a -> a -> Bool
func = (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
func Gen (a, a)
forall a. Arbitrary a => Gen a
arbitrary a -> [a]
forall a. Arbitrary a => a -> [a]
shrink