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

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

import Data.Data
import Data.GenValidity
import Test.QuickCheck
import Test.Syd
import Test.Syd.Validity.Functions
import Test.Syd.Validity.Relations
import Test.Syd.Validity.Utils

eqTypeStr ::
  forall a.
  Typeable a =>
  String
eqTypeStr = binRelStr @a "=="

neqTypeStr ::
  forall a.
  Typeable a =>
  String
neqTypeStr = binRelStr @a "/="

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

-- | 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 = eqSpecOnGen @a arbitrary "arbitrary" 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 genname s =
  parallel $ do
    let name = nameOf @a
        funeqstr = eqTypeStr @a
        funneqstr = neqTypeStr @a
        gen2 = (,) <$> gen <*> gen
        gen3 = (,,) <$> gen <*> gen <*> gen
        s2 = shrinkT2 s
    describe ("Eq " ++ name) $ do
      let eq = (==) @a
          neq = (/=) @a
      describe funeqstr $ do
        it
          ( unwords
              [ "is reflexive for",
                "\"" ++ genname,
                name ++ "\"" ++ "s"
              ]
          )
          $ reflexivityOnGen eq gen s
        it
          ( unwords
              [ "is symmetric for",
                "\"" ++ genname,
                name ++ "\"" ++ "s"
              ]
          )
          $ symmetryOnGens eq gen2 s
        it
          ( unwords
              [ "is transitive for",
                "\"" ++ genname,
                name ++ "\"" ++ "s"
              ]
          )
          $ transitivityOnGens eq gen3 s
        it
          ( unwords
              [ "is equivalent to (\\a b -> not $ a /= b) for",
                "\"" ++ genname,
                name ++ "\"" ++ "s"
              ]
          )
          $ equivalentOnGens2 eq (\a b -> not $ a `neq` b) gen2 s2
      describe funneqstr $ do
        it
          ( unwords
              [ "is antireflexive for",
                "\"" ++ genname,
                name ++ "\"" ++ "s"
              ]
          )
          $ antireflexivityOnGen neq gen s
        it
          ( unwords
              [ "is equivalent to (\\a b -> not $ a == b) for",
                "\"" ++ genname,
                name ++ "\"" ++ "s"
              ]
          )
          $ equivalentOnGens2 neq (\a b -> not $ a `eq` b) gen2 s2