TypesProps.hs

module Props.TypesProps (tests) where

-- hedgehog
import Hedgehog
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range

-- tasty / tasty-hedgehog
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.Hedgehog (testProperty)

-- restman
import Types
  (AppR(..), CustomHeaderColumn(..), CustomHeaderR(..), RangeInAlign(..))

tests :: TestTree
tests = testGroup "Props.Types"
  [ rangeInAlignProps
  , customHeaderColumnProps
  , customHeaderRProps
  , appRProps
  ]

-- ---------------------------------------------------------------------------
-- Generators
-- ---------------------------------------------------------------------------

genRangeInAlign :: Gen RangeInAlign
genRangeInAlign = Gen.element [Min, MidL, MidG, Max]

genCustomHeaderColumn :: Gen CustomHeaderColumn
genCustomHeaderColumn = Gen.element [ActiveToggle, NameEditor, ValueEditor]

genCustomHeaderR :: Gen CustomHeaderR
genCustomHeaderR = MkCustomHeaderR
  <$> Gen.int (Range.linear 0 100)
  <*> genCustomHeaderColumn

-- AppR without ExistingCustomHeader to keep generation simple.
genSimpleAppR :: Gen AppR
genSimpleAppR = Gen.element
  [ MethodEditor, UrlEditor, DefaultHeadersToggle
  , AddCustomHeader, ResponseBodyView, MethodSelector
  ]

-- ---------------------------------------------------------------------------
-- Ord law helpers
-- ---------------------------------------------------------------------------

-- Ord reflexivity: compare x x == EQ
prop_ord_reflexive :: (Show a, Ord a) => Gen a -> Property
prop_ord_reflexive gen = property $ do
  x <- forAll gen
  compare x x === EQ

-- Ord antisymmetry: compare x y == opposite of compare y x
prop_ord_antisymmetric :: (Show a, Ord a) => Gen a -> Property
prop_ord_antisymmetric gen = property $ do
  x <- forAll gen
  y <- forAll gen
  compare x y === flipOrd (compare y x)
 where
  flipOrd LT = GT
  flipOrd GT = LT
  flipOrd EQ = EQ

-- Ord transitivity: x <= y && y <= z implies x <= z
prop_ord_transitive :: (Show a, Ord a) => Gen a -> Property
prop_ord_transitive gen = property $ do
  x <- forAll gen
  y <- forAll gen
  z <- forAll gen
  if x <= y && y <= z
    then assert (x <= z)
    else success

-- Eq/Ord consistency: (x == y) iff (compare x y == EQ)
prop_eq_ord_consistent :: (Show a, Eq a) => Gen a -> Property
prop_eq_ord_consistent gen = property $ do
  x <- forAll gen
  y <- forAll gen
  (x == y) === (y == x)

-- ---------------------------------------------------------------------------
-- RangeInAlign
-- ---------------------------------------------------------------------------

rangeInAlignProps :: TestTree
rangeInAlignProps = testGroup "RangeInAlign Ord"
  [ testProperty "reflexive"             (prop_ord_reflexive     genRangeInAlign)
  , testProperty "antisymmetric"         (prop_ord_antisymmetric genRangeInAlign)
  , testProperty "transitive"            (prop_ord_transitive    genRangeInAlign)
  , testProperty "Eq/Ord consistent"     (prop_eq_ord_consistent genRangeInAlign)
  , testProperty "total: every pair is comparable" $ property $ do
      x <- forAll genRangeInAlign
      y <- forAll genRangeInAlign
      assert $ compare x y `elem` [LT, EQ, GT]
  ]

-- ---------------------------------------------------------------------------
-- CustomHeaderColumn
-- ---------------------------------------------------------------------------

customHeaderColumnProps :: TestTree
customHeaderColumnProps = testGroup "CustomHeaderColumn Ord"
  [ testProperty "reflexive"             (prop_ord_reflexive     genCustomHeaderColumn)
  , testProperty "antisymmetric"         (prop_ord_antisymmetric genCustomHeaderColumn)
  , testProperty "transitive"            (prop_ord_transitive    genCustomHeaderColumn)
  , testProperty "Eq/Ord consistent"     (prop_eq_ord_consistent genCustomHeaderColumn)
  ]

-- ---------------------------------------------------------------------------
-- CustomHeaderR
-- Ordering is lexicographic: first by listIndex, then by column.
-- ---------------------------------------------------------------------------

customHeaderRProps :: TestTree
customHeaderRProps = testGroup "CustomHeaderR Ord"
  [ testProperty "reflexive"             (prop_ord_reflexive     genCustomHeaderR)
  , testProperty "antisymmetric"         (prop_ord_antisymmetric genCustomHeaderR)
  , testProperty "transitive"            (prop_ord_transitive    genCustomHeaderR)
  , testProperty "Eq/Ord consistent"     (prop_eq_ord_consistent genCustomHeaderR)
  , testProperty "larger listIndex sorts later" $ property $ do
      i <- forAll $ Gen.int (Range.linear 0 99)
      col1 <- forAll genCustomHeaderColumn
      col2 <- forAll genCustomHeaderColumn
      let lo = MkCustomHeaderR i       col1
          hi = MkCustomHeaderR (i + 1) col2
      assert (lo < hi)
  , testProperty "same listIndex: column determines order" $ property $ do
      i    <- forAll $ Gen.int (Range.linear 0 100)
      col1 <- forAll genCustomHeaderColumn
      col2 <- forAll genCustomHeaderColumn
      let r1 = MkCustomHeaderR i col1
          r2 = MkCustomHeaderR i col2
      compare r1 r2 === compare col1 col2
  ]

-- ---------------------------------------------------------------------------
-- AppR (simple constructors only — ExistingCustomHeader wraps CustomHeaderR)
-- ---------------------------------------------------------------------------

appRProps :: TestTree
appRProps = testGroup "AppR Ord (simple constructors)"
  [ testProperty "reflexive"             (prop_ord_reflexive     genSimpleAppR)
  , testProperty "antisymmetric"         (prop_ord_antisymmetric genSimpleAppR)
  , testProperty "transitive"            (prop_ord_transitive    genSimpleAppR)
  , testProperty "Eq/Ord consistent"     (prop_eq_ord_consistent genSimpleAppR)
  ]