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) ]