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

-- | Ord properties
--
-- You will need @TypeApplications@ to use these.
module Test.Syd.Validity.Ord
  ( ordSpecOnGen,
    ordSpec,
    ordSpecOnArbitrary,
  )
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

{-# ANN module "HLint: ignore Use <=" #-}

{-# ANN module "HLint: ignore Use >=" #-}

{-# ANN module "HLint: ignore Use <" #-}

{-# ANN module "HLint: ignore Use >" #-}

leTypeStr ::
  forall a.
  Typeable a =>
  String
leTypeStr = binRelStr @a "<="

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

ltTypeStr ::
  forall a.
  Typeable a =>
  String
ltTypeStr = binRelStr @a "<"

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

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

-- | Standard test spec for properties of Ord instances for arbitrary values
--
-- Example usage:
--
-- > ordSpecOnArbitrary @Int
ordSpecOnArbitrary ::
  forall a.
  (Show a, Ord a, Typeable a, Arbitrary a) =>
  Spec
ordSpecOnArbitrary = ordSpecOnGen @a arbitrary "arbitrary" shrink

-- | Standard test spec for properties of Ord instances for values generated by a given generator (and name for that generator).
--
-- Example usage:
--
-- > ordSpecOnGen ((* 2) <$> genValid @Int) "even"
ordSpecOnGen ::
  forall a.
  (Show a, Ord a, Typeable a) =>
  Gen a ->
  String ->
  (a -> [a]) ->
  Spec
ordSpecOnGen gen genname s =
  parallel $ do
    let name = nameOf @a
        funlestr = leTypeStr @a
        fungestr = geTypeStr @a
        funltstr = ltTypeStr @a
        fungtstr = gtTypeStr @a
        minmaxtstr = genDescr @(a -> a -> a)
        itProp s_ =
          it $
            unwords
              [ s_,
                "\"" ++ genname,
                name ++ "\"" ++ "'s"
              ]
        cmple = (<=) @a
        cmpge = (>=) @a
        cmplt = (<) @a
        cmpgt = (>) @a
        gen2 = (,) <$> gen <*> gen
        gen3 = (,,) <$> gen <*> gen <*> gen
        s2 = shrinkT2 s
    describe ("Ord " ++ name) $ do
      describe funlestr $ do
        itProp "is reflexive for" $
          reflexivityOnGen cmple gen s
        itProp "is antisymmetric for" $
          antisymmetryOnGens cmple gen2 s
        itProp "is transitive for" $
          transitivityOnGens cmple gen3 s
        itProp "is equivalent to (\\a b -> compare a b /= GT) for" $
          equivalentOnGens2 cmple (\a b -> compare a b /= GT) gen2 s2
      describe fungestr $ do
        itProp "is reflexive for" $
          reflexivityOnGen cmpge gen s
        itProp "is antisymmetric for" $
          antisymmetryOnGens cmpge gen2 s
        itProp "is transitive for" $
          transitivityOnGens cmpge gen3 s
        itProp "is equivalent to (\\a b -> compare a b /= LT) for" $
          equivalentOnGens2 cmpge (\a b -> compare a b /= LT) gen2 s2
      describe funltstr $ do
        itProp "is antireflexive for" $
          antireflexivityOnGen cmplt gen s
        itProp "is transitive for" $
          transitivityOnGens cmplt gen3 s
        itProp "is equivalent to (\\a b -> compare a b == LT) for" $
          equivalentOnGens2 cmplt (\a b -> compare a b == LT) gen2 s2
      describe fungtstr $ do
        itProp "is antireflexive for" $
          antireflexivityOnGen cmpgt gen s
        itProp "is transitive for" $
          transitivityOnGens cmpgt gen3 s
        itProp "is equivalent to (\\a b -> compare a b == GT) for" $
          equivalentOnGens2 cmpgt (\a b -> compare a b == GT) gen2 s2
      describe (minmaxtstr "min") $ do
        itProp "is equivalent to (\\a b -> if a <= b then a else b) for" $
          equivalentOnGens2 min (\a b -> if a <= b then a else b) gen2 s2
      describe (minmaxtstr "max") $ do
        itProp "is equivalent to (\\a b -> if a >= b then a else b) for" $
          equivalentOnGens2 max (\a b -> if a >= b then a else b) gen2 s2