genvalidity-property-1.0.0.0/src/0000755000000000000000000000000014056371150015026 5ustar0000000000000000genvalidity-property-1.0.0.0/src/Test/0000755000000000000000000000000014056371150015745 5ustar0000000000000000genvalidity-property-1.0.0.0/src/Test/Validity/0000755000000000000000000000000014146214612017531 5ustar0000000000000000genvalidity-property-1.0.0.0/src/Test/Validity/Functions/0000755000000000000000000000000014146214612021501 5ustar0000000000000000genvalidity-property-1.0.0.0/src/Test/Validity/GenValidity/0000755000000000000000000000000014142332300021737 5ustar0000000000000000genvalidity-property-1.0.0.0/src/Test/Validity/Operations/0000755000000000000000000000000014146214612021654 5ustar0000000000000000genvalidity-property-1.0.0.0/src/Test/Validity/Property/0000755000000000000000000000000014146214612021355 5ustar0000000000000000genvalidity-property-1.0.0.0/src/Test/Validity/Relations/0000755000000000000000000000000014146214612021471 5ustar0000000000000000genvalidity-property-1.0.0.0/src/Test/Validity/Shrinking/0000755000000000000000000000000014146214612021465 5ustar0000000000000000genvalidity-property-1.0.0.0/test/0000755000000000000000000000000014142324034015211 5ustar0000000000000000genvalidity-property-1.0.0.0/test/Test/0000755000000000000000000000000014056371150016135 5ustar0000000000000000genvalidity-property-1.0.0.0/test/Test/Validity/0000755000000000000000000000000014056371150017722 5ustar0000000000000000genvalidity-property-1.0.0.0/test/Test/Validity/Operations/0000755000000000000000000000000014146214612022044 5ustar0000000000000000genvalidity-property-1.0.0.0/src/Test/Validity/Functions.hs0000644000000000000000000000112014146214612022027 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} -- | Validity tests involving functions module Test.Validity.Functions ( module Test.Validity.Functions.CanFail, module Test.Validity.Functions.Equivalence, module Test.Validity.Functions.Idempotence, module Test.Validity.Functions.Inverse, module Test.Validity.Functions.Validity, ) where import Test.Validity.Functions.CanFail import Test.Validity.Functions.Equivalence import Test.Validity.Functions.Idempotence import Test.Validity.Functions.Inverse import Test.Validity.Functions.Validity genvalidity-property-1.0.0.0/src/Test/Validity/Functions/CanFail.hs0000644000000000000000000001202714146214612023334 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} module Test.Validity.Functions.CanFail ( succeedsOnGen, succeeds, succeedsOnArbitrary, succeedsOnGens2, succeeds2, succeedsOnArbitrary2, failsOnGen, failsOnGens2, validIfSucceedsOnGen, validIfSucceedsOnArbitrary, validIfSucceeds, validIfSucceedsOnGens2, validIfSucceeds2, validIfSucceedsOnArbitrary2, validIfSucceedsOnGens3, validIfSucceeds3, validIfSucceedsOnArbitrary3, ) where import Data.GenValidity import Test.Hspec import Test.QuickCheck import Test.Validity.Property.Utils import Test.Validity.Types -- | The function succeeds if the input is generated by the given generator succeedsOnGen :: (Show a, Show (f b), CanFail f) => (a -> f b) -> Gen a -> (a -> [a]) -> Property succeedsOnGen func gen s = forAllShrink gen s $ \a -> func a `shouldSatisfy` (not . hasFailed) -- | The function succeeds if the input is generated by @genValid@ succeeds :: (Show a, Show (f b), GenValid a, CanFail f) => (a -> f b) -> Property succeeds f = succeedsOnGen f genValid shrinkValid -- | The function succeeds if the input is generated by @arbitrary@ succeedsOnArbitrary :: (Show a, Show (f b), Arbitrary a, CanFail f) => (a -> f b) -> Property succeedsOnArbitrary f = succeedsOnGen f arbitrary shrink -- | The function fails if the input is generated by the given generator failsOnGen :: (Show a, Show (f b), CanFail f) => (a -> f b) -> Gen a -> (a -> [a]) -> Property failsOnGen func gen s = forAllShrink gen s $ \a -> func a `shouldSatisfy` hasFailed -- | The function produces output that satisfies @isValid@ if it is given input -- that is generated by the given generator. validIfSucceedsOnGen :: (Show a, Show b, Validity b, CanFail f) => (a -> f b) -> Gen a -> (a -> [a]) -> Property validIfSucceedsOnGen func gen s = forAllShrink gen s $ \a -> case resultIfSucceeded (func a) of Nothing -> return () -- Can happen Just res -> shouldBeValid res -- | The function produces output that satisfies @isValid@ if it is given input -- that is generated by @arbitrary@. validIfSucceedsOnArbitrary :: (Show a, Show b, Arbitrary a, Validity b, CanFail f) => (a -> f b) -> Property validIfSucceedsOnArbitrary f = validIfSucceedsOnGen f arbitrary shrink -- | The function produces output that satisfies @isValid@ if it is given input -- that is generated by @genValid@. validIfSucceeds :: (Show a, Show b, GenValid a, Validity b, CanFail f) => (a -> f b) -> Property validIfSucceeds f = validIfSucceedsOnGen f genValid shrinkValid succeedsOnGens2 :: (Show a, Show b, Show (f c), CanFail f) => (a -> b -> f c) -> Gen (a, b) -> ((a, b) -> [(a, b)]) -> Property succeedsOnGens2 func gen s = forAllShrink gen s $ \(a, b) -> func a b `shouldSatisfy` (not . hasFailed) succeeds2 :: (Show a, Show b, Show (f c), GenValid a, GenValid b, CanFail f) => (a -> b -> f c) -> Property succeeds2 func = succeedsOnGens2 func genValid shrinkValid succeedsOnArbitrary2 :: (Show a, Show b, Show (f c), Arbitrary a, Arbitrary b, CanFail f) => (a -> b -> f c) -> Property succeedsOnArbitrary2 func = succeedsOnGens2 func arbitrary shrink failsOnGens2 :: (Show a, Show b, Show (f c), CanFail f) => (a -> b -> f c) -> Gen a -> (a -> [a]) -> Gen b -> (b -> [b]) -> Property failsOnGens2 func genA sA genB sB = forAllShrink genA sA $ \a -> forAllShrink genB sB $ \b -> func a b `shouldSatisfy` hasFailed validIfSucceedsOnGens2 :: (Show a, Show b, Show c, Validity c, CanFail f) => (a -> b -> f c) -> Gen (a, b) -> ((a, b) -> [(a, b)]) -> Property validIfSucceedsOnGens2 func gen s = forAllShrink gen s $ \(a, b) -> case resultIfSucceeded (func a b) of Nothing -> return () -- Can happen Just res -> shouldBeValid res validIfSucceeds2 :: (Show a, Show b, Show c, GenValid a, GenValid b, Validity c, CanFail f) => (a -> b -> f c) -> Property validIfSucceeds2 func = validIfSucceedsOnGens2 func genValid shrinkValid validIfSucceedsOnArbitrary2 :: (Show a, Show b, Show c, Arbitrary a, Arbitrary b, Validity c, CanFail f) => (a -> b -> f c) -> Property validIfSucceedsOnArbitrary2 func = validIfSucceedsOnGens2 func arbitrary shrink validIfSucceedsOnGens3 :: (Show a, Show b, Show c, Show d, Validity d, CanFail f) => (a -> b -> c -> f d) -> Gen (a, b, c) -> ((a, b, c) -> [(a, b, c)]) -> Property validIfSucceedsOnGens3 func gen s = forAllShrink gen s $ \(a, b, c) -> case resultIfSucceeded (func a b c) of Nothing -> return () -- Can happen Just res -> shouldBeValid res validIfSucceeds3 :: ( Show a, Show b, Show c, Show d, GenValid a, GenValid b, GenValid c, Validity d, CanFail f ) => (a -> b -> c -> f d) -> Property validIfSucceeds3 func = validIfSucceedsOnGens3 func genValid shrinkValid validIfSucceedsOnArbitrary3 :: (Show a, Show b, Show c, Show d, Arbitrary a, Arbitrary b, Arbitrary c, Validity d, CanFail f) => (a -> b -> c -> f d) -> Property validIfSucceedsOnArbitrary3 func = validIfSucceedsOnGens3 func arbitrary shrink genvalidity-property-1.0.0.0/src/Test/Validity/Functions/Equivalence.hs0000644000000000000000000002041014146214612024273 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} module Test.Validity.Functions.Equivalence ( equivalentOnGen, equivalent, equivalentOnArbitrary, equivalentOnGens2, equivalent2, equivalentOnArbitrary2, equivalentWhenFirstSucceedsOnGen, equivalentWhenFirstSucceeds, equivalentWhenFirstSucceedsOnArbitrary, equivalentWhenFirstSucceedsOnGens2, equivalentWhenFirstSucceeds2, equivalentWhenFirstSucceedsOnArbitrary2, equivalentWhenSecondSucceedsOnGen, equivalentWhenSecondSucceeds, equivalentWhenSecondSucceedsOnArbitrary, equivalentWhenSecondSucceedsOnGens2, equivalentWhenSecondSucceeds2, equivalentWhenSecondSucceedsOnArbitrary2, equivalentWhenSucceedOnGen, equivalentWhenSucceed, equivalentWhenSucceedOnArbitrary, equivalentWhenSucceedOnGens2, equivalentWhenSucceed2, equivalentWhenSucceedOnArbitrary2, equivalentOnGens3, equivalent3, equivalentOnArbitrary3, ) where import Data.GenValidity import Test.Hspec import Test.QuickCheck import Test.Validity.Types equivalentOnGen :: (Show a, Show b, Eq b) => (a -> b) -> (a -> b) -> Gen a -> (a -> [a]) -> Property equivalentOnGen f g gen s = forAllShrink gen s $ \a -> f a `shouldBe` g a equivalent :: (Show a, GenValid a, Show b, Eq b) => (a -> b) -> (a -> b) -> Property equivalent f g = equivalentOnGen f g genValid shrinkValid -- | -- -- prop> equivalentOnArbitrary ((* 2) . (+ 1)) ((+ 2) . (* 2) :: Int -> Int) equivalentOnArbitrary :: (Show a, Arbitrary a, Show b, Eq b) => (a -> b) -> (a -> b) -> Property equivalentOnArbitrary f g = equivalentOnGen f g arbitrary shrink equivalentOnGens2 :: (Show a, Show b, Show c, Eq c) => (a -> b -> c) -> (a -> b -> c) -> Gen (a, b) -> ((a, b) -> [(a, b)]) -> Property equivalentOnGens2 f g gen s = forAllShrink gen s $ \(a, b) -> f a b `shouldBe` g a b equivalent2 :: (Show a, GenValid a, Show b, GenValid b, Show c, Eq c) => (a -> b -> c) -> (a -> b -> c) -> Property equivalent2 f g = equivalentOnGens2 f g genValid shrinkValid -- | -- -- prop> equivalentOnArbitrary2 (+) ((+) :: Int -> Int -> Int) equivalentOnArbitrary2 :: (Show a, Arbitrary a, Show b, Arbitrary b, Show c, Eq c) => (a -> b -> c) -> (a -> b -> c) -> Property equivalentOnArbitrary2 f g = equivalentOnGens2 f g arbitrary shrink equivalentWhenFirstSucceedsOnGen :: (Show a, Show b, Eq b, CanFail f) => (a -> f b) -> (a -> b) -> Gen a -> (a -> [a]) -> Property equivalentWhenFirstSucceedsOnGen f g gen s = forAllShrink gen s $ \a -> case resultIfSucceeded (f a) of Nothing -> return () -- fine Just r -> r `shouldBe` g a equivalentWhenFirstSucceedsOnArbitrary :: (Show a, Arbitrary a, Show b, Eq b, CanFail f) => (a -> f b) -> (a -> b) -> Property equivalentWhenFirstSucceedsOnArbitrary f g = equivalentWhenFirstSucceedsOnGen f g arbitrary shrink equivalentWhenFirstSucceeds :: (Show a, GenValid a, Show b, Eq b, CanFail f) => (a -> f b) -> (a -> b) -> Property equivalentWhenFirstSucceeds f g = equivalentWhenFirstSucceedsOnGen f g genValid shrinkValid equivalentWhenFirstSucceedsOnGens2 :: (Show a, Show b, Show c, Eq c, CanFail f) => (a -> b -> f c) -> (a -> b -> c) -> Gen (a, b) -> ((a, b) -> [(a, b)]) -> Property equivalentWhenFirstSucceedsOnGens2 f g gen s = forAllShrink gen s $ \(a, b) -> case resultIfSucceeded (f a b) of Nothing -> return () -- fine Just rs -> rs `shouldBe` g a b equivalentWhenFirstSucceedsOnArbitrary2 :: ( Show a, Arbitrary a, Show b, Arbitrary b, Show c, Eq c, CanFail f ) => (a -> b -> f c) -> (a -> b -> c) -> Property equivalentWhenFirstSucceedsOnArbitrary2 f g = equivalentWhenFirstSucceedsOnGens2 f g arbitrary shrink equivalentWhenFirstSucceeds2 :: ( Show a, GenValid a, Show b, GenValid b, Show c, Eq c, CanFail f ) => (a -> b -> f c) -> (a -> b -> c) -> Property equivalentWhenFirstSucceeds2 f g = equivalentWhenFirstSucceedsOnGens2 f g genValid shrinkValid equivalentWhenSecondSucceedsOnGen :: (Show a, Show b, Eq b, CanFail f) => (a -> b) -> (a -> f b) -> Gen a -> (a -> [a]) -> Property equivalentWhenSecondSucceedsOnGen f g gen s = forAllShrink gen s $ \a -> case resultIfSucceeded (g a) of Nothing -> return () -- fine Just r -> r `shouldBe` f a equivalentWhenSecondSucceedsOnArbitrary :: (Show a, Arbitrary a, Show b, Eq b, CanFail f) => (a -> b) -> (a -> f b) -> Property equivalentWhenSecondSucceedsOnArbitrary f g = equivalentWhenSecondSucceedsOnGen f g arbitrary shrink equivalentWhenSecondSucceeds :: (Show a, GenValid a, Show b, Eq b, CanFail f) => (a -> b) -> (a -> f b) -> Property equivalentWhenSecondSucceeds f g = equivalentWhenSecondSucceedsOnGen f g genValid shrinkValid equivalentWhenSecondSucceedsOnGens2 :: (Show a, Show b, Show c, Eq c, CanFail f) => (a -> b -> c) -> (a -> b -> f c) -> Gen (a, b) -> ((a, b) -> [(a, b)]) -> Property equivalentWhenSecondSucceedsOnGens2 f g gen s = forAllShrink gen s $ \(a, b) -> case resultIfSucceeded (g a b) of Nothing -> return () -- fine Just rs -> rs `shouldBe` f a b equivalentWhenSecondSucceedsOnArbitrary2 :: ( Show a, Arbitrary a, Show b, Arbitrary b, Show c, Eq c, CanFail f ) => (a -> b -> c) -> (a -> b -> f c) -> Property equivalentWhenSecondSucceedsOnArbitrary2 f g = equivalentWhenSecondSucceedsOnGens2 f g arbitrary shrink equivalentWhenSecondSucceeds2 :: ( Show a, GenValid a, Show b, GenValid b, Show c, Eq c, CanFail f ) => (a -> b -> c) -> (a -> b -> f c) -> Property equivalentWhenSecondSucceeds2 f g = equivalentWhenSecondSucceedsOnGens2 f g genValid shrinkValid equivalentWhenSucceedOnGen :: (Show a, Show b, Eq b, CanFail f) => (a -> f b) -> (a -> f b) -> Gen a -> (a -> [a]) -> Property equivalentWhenSucceedOnGen f g gen s = forAllShrink gen s $ \a -> case do fa <- resultIfSucceeded $ f a ga <- resultIfSucceeded $ g a return (fa, ga) of Nothing -> return () -- fine Just (fa, ga) -> fa `shouldBe` ga equivalentWhenSucceed :: (Show a, GenValid a, Show b, Eq b, CanFail f) => (a -> f b) -> (a -> f b) -> Property equivalentWhenSucceed f g = equivalentWhenSucceedOnGen f g genValid shrinkValid equivalentWhenSucceedOnArbitrary :: (Show a, Arbitrary a, Show b, Eq b, CanFail f) => (a -> f b) -> (a -> f b) -> Property equivalentWhenSucceedOnArbitrary f g = equivalentWhenSucceedOnGen f g arbitrary shrink equivalentWhenSucceedOnGens2 :: (Show a, Show b, Show c, Eq c, CanFail f) => (a -> b -> f c) -> (a -> b -> f c) -> Gen (a, b) -> ((a, b) -> [(a, b)]) -> Property equivalentWhenSucceedOnGens2 f g gen s = forAllShrink gen s $ \(a, b) -> case do fab <- resultIfSucceeded $ f a b gab <- resultIfSucceeded $ g a b return (fab, gab) of Nothing -> return () -- fine Just (fab, gab) -> fab `shouldBe` gab equivalentWhenSucceedOnArbitrary2 :: ( Show a, Arbitrary a, Show b, Arbitrary b, Show c, Eq c, CanFail f ) => (a -> b -> f c) -> (a -> b -> f c) -> Property equivalentWhenSucceedOnArbitrary2 f g = equivalentWhenSucceedOnGens2 f g arbitrary shrink equivalentWhenSucceed2 :: ( Show a, GenValid a, Show b, GenValid b, Show c, Eq c, CanFail f ) => (a -> b -> f c) -> (a -> b -> f c) -> Property equivalentWhenSucceed2 f g = equivalentWhenSucceedOnGens2 f g genValid shrinkValid equivalentOnGens3 :: (Show a, Show b, Show c, Show d, Eq d) => (a -> b -> c -> d) -> (a -> b -> c -> d) -> Gen (a, b, c) -> ((a, b, c) -> [(a, b, c)]) -> Property equivalentOnGens3 f g gen s = forAllShrink gen s $ \(a, b, c) -> f a b c `shouldBe` g a b c equivalent3 :: ( Show a, GenValid a, Show b, GenValid b, Show c, GenValid c, Show d, Eq d ) => (a -> b -> c -> d) -> (a -> b -> c -> d) -> Property equivalent3 f g = equivalentOnGens3 f g genValid shrinkValid equivalentOnArbitrary3 :: ( Show a, Arbitrary a, Show b, Arbitrary b, Show c, Arbitrary c, Show d, Eq d ) => (a -> b -> c -> d) -> (a -> b -> c -> d) -> Property equivalentOnArbitrary3 f g = equivalentOnGens3 f g arbitrary shrink genvalidity-property-1.0.0.0/src/Test/Validity/Functions/Idempotence.hs0000644000000000000000000000170114146214612024270 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} -- | Standard tests involving validity module Test.Validity.Functions.Idempotence ( idempotentOnGen, idempotent, idempotentOnArbitrary, ) where import Data.GenValidity import Test.Hspec import Test.QuickCheck idempotentOnGen :: (Show a, Eq a) => (a -> a) -> Gen a -> (a -> [a]) -> Property idempotentOnGen f gen s = forAllShrink gen s $ \a -> f (f a) `shouldBe` f a idempotent :: (Show a, Eq a, GenValid a) => (a -> a) -> Property idempotent func = idempotentOnGen func genValid shrinkValid -- | -- -- 'id' is idempotent for any type: -- -- prop> idempotentOnArbitrary (id :: Int -> Int) -- -- 'const', given any input, is idempotent for any type as well: -- -- prop> \int -> idempotentOnArbitrary (const int :: Int -> Int) idempotentOnArbitrary :: (Show a, Eq a, Arbitrary a) => (a -> a) -> Property idempotentOnArbitrary func = idempotentOnGen func arbitrary shrink genvalidity-property-1.0.0.0/src/Test/Validity/Functions/Inverse.hs0000644000000000000000000000724414146214612023457 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} -- | Standard tests involving inverse functions module Test.Validity.Functions.Inverse ( inverseFunctionsOnGen, inverseFunctions, inverseFunctionsOnArbitrary, inverseFunctionsIfFirstSucceedsOnGen, inverseFunctionsIfFirstSucceeds, inverseFunctionsIfFirstSucceedsOnArbitrary, inverseFunctionsIfSecondSucceedsOnGen, inverseFunctionsIfSecondSucceeds, inverseFunctionsIfSecondSucceedsOnArbitrary, inverseFunctionsIfSucceedOnGen, inverseFunctionsIfSucceed, inverseFunctionsIfSucceedOnArbitrary, ) where import Data.GenValidity import Test.Hspec import Test.QuickCheck import Test.Validity.Types inverseFunctionsOnGen :: (Show a, Eq a) => (a -> b) -> (b -> a) -> Gen a -> (a -> [a]) -> Property inverseFunctionsOnGen f g gen s = forAllShrink gen s $ \a -> g (f a) `shouldBe` a inverseFunctions :: (Show a, Eq a, GenValid a) => (a -> b) -> (b -> a) -> Property inverseFunctions f g = inverseFunctionsOnGen f g genValid shrinkValid -- | -- 'id' is its own inverse function for every type: -- prop> inverseFunctionsOnArbitrary id (id :: Int -> Int) inverseFunctionsOnArbitrary :: (Show a, Eq a, Arbitrary a) => (a -> b) -> (b -> a) -> Property inverseFunctionsOnArbitrary f g = inverseFunctionsOnGen f g arbitrary shrink inverseFunctionsIfFirstSucceedsOnGen :: (Show a, Eq a, CanFail f) => (a -> f b) -> (b -> a) -> Gen a -> (a -> [a]) -> Property inverseFunctionsIfFirstSucceedsOnGen f g gen s = forAllShrink gen s $ \a -> case resultIfSucceeded (f a) of Nothing -> return () -- fine Just b -> g b `shouldBe` a inverseFunctionsIfFirstSucceeds :: (Show a, Eq a, GenValid a, CanFail f) => (a -> f b) -> (b -> a) -> Property inverseFunctionsIfFirstSucceeds f g = inverseFunctionsIfFirstSucceedsOnGen f g genValid shrinkValid inverseFunctionsIfFirstSucceedsOnArbitrary :: (Show a, Eq a, Arbitrary a, CanFail f) => (a -> f b) -> (b -> a) -> Property inverseFunctionsIfFirstSucceedsOnArbitrary f g = inverseFunctionsIfFirstSucceedsOnGen f g arbitrary shrink inverseFunctionsIfSecondSucceedsOnGen :: (Show a, Eq a, CanFail f) => (a -> b) -> (b -> f a) -> Gen a -> (a -> [a]) -> Property inverseFunctionsIfSecondSucceedsOnGen f g gen s = forAllShrink gen s $ \a -> case resultIfSucceeded (g (f a)) of Nothing -> return () -- fine Just r -> r `shouldBe` a inverseFunctionsIfSecondSucceeds :: (Show a, Eq a, GenValid a, CanFail f) => (a -> b) -> (b -> f a) -> Property inverseFunctionsIfSecondSucceeds f g = inverseFunctionsIfSecondSucceedsOnGen f g genValid shrinkValid inverseFunctionsIfSecondSucceedsOnArbitrary :: (Show a, Eq a, Arbitrary a, CanFail f) => (a -> b) -> (b -> f a) -> Property inverseFunctionsIfSecondSucceedsOnArbitrary f g = inverseFunctionsIfSecondSucceedsOnGen f g arbitrary shrink inverseFunctionsIfSucceedOnGen :: (Show a, Eq a, CanFail f, CanFail g) => (a -> f b) -> (b -> g a) -> Gen a -> (a -> [a]) -> Property inverseFunctionsIfSucceedOnGen f g gen s = forAllShrink gen s $ \a -> case do fa <- resultIfSucceeded $ f a resultIfSucceeded $ g fa of Nothing -> return () -- fine Just r -> r `shouldBe` a inverseFunctionsIfSucceed :: (Show a, Eq a, GenValid a, CanFail f, CanFail g) => (a -> f b) -> (b -> g a) -> Property inverseFunctionsIfSucceed f g = inverseFunctionsIfSucceedOnGen f g genValid shrinkValid inverseFunctionsIfSucceedOnArbitrary :: (Show a, Eq a, Arbitrary a, CanFail f, CanFail g) => (a -> f b) -> (b -> g a) -> Property inverseFunctionsIfSucceedOnArbitrary f g = inverseFunctionsIfSucceedOnGen f g arbitrary shrink genvalidity-property-1.0.0.0/src/Test/Validity/Functions/Validity.hs0000644000000000000000000000515414146214612023627 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} -- | Standard tests involving validity module Test.Validity.Functions.Validity ( producesValidsOnGen, producesValid, producesValidsOnArbitrary, producesValidsOnGens2, producesValid2, producesValidsOnArbitrary2, producesValidsOnGens3, producesValid3, producesValidsOnArbitrary3, ) where import Data.GenValidity import Test.QuickCheck import Test.Validity.Property.Utils -- | The function produces valid output when the input is generated as -- specified by the given generator. producesValidsOnGen :: forall a b. (Show a, Show b, Validity b) => (a -> b) -> Gen a -> (a -> [a]) -> Property producesValidsOnGen func gen s = forAllShrink gen s $ shouldBeValid . func -- | The function produces valid output when the input is generated by -- @genValid@ producesValid :: (Show a, Show b, GenValid a, Validity b) => (a -> b) -> Property producesValid f = producesValidsOnGen f genValid shrinkValid -- | The function produces valid output when the input is generated by -- @arbitrary@ producesValidsOnArbitrary :: (Show a, Show b, Arbitrary a, Validity b) => (a -> b) -> Property producesValidsOnArbitrary f = producesValidsOnGen f arbitrary shrink producesValidsOnGens2 :: (Show a, Show b, Show c, Validity c) => (a -> b -> c) -> Gen (a, b) -> ((a, b) -> [(a, b)]) -> Property producesValidsOnGens2 func gen s = forAllShrink gen s $ \(a, b) -> shouldBeValid $ func a b producesValid2 :: (Show a, Show b, Show c, GenValid a, GenValid b, Validity c) => (a -> b -> c) -> Property producesValid2 func = producesValidsOnGens2 func genValid shrinkValid producesValidsOnArbitrary2 :: (Show a, Show b, Show c, Arbitrary a, Arbitrary b, Validity c) => (a -> b -> c) -> Property producesValidsOnArbitrary2 func = producesValidsOnGens2 func arbitrary shrink producesValidsOnGens3 :: (Show a, Show b, Show c, Show d, Validity d) => (a -> b -> c -> d) -> Gen (a, b, c) -> ((a, b, c) -> [(a, b, c)]) -> Property producesValidsOnGens3 func gen s = forAllShrink gen s $ \(a, b, c) -> shouldBeValid $ func a b c producesValid3 :: ( Show a, Show b, Show c, Show d, GenValid a, GenValid b, GenValid c, Validity d ) => (a -> b -> c -> d) -> Property producesValid3 func = producesValidsOnGens3 func genValid shrinkValid producesValidsOnArbitrary3 :: ( Show a, Show b, Show c, Show d, Arbitrary a, Arbitrary b, Arbitrary c, Validity d ) => (a -> b -> c -> d) -> Property producesValidsOnArbitrary3 func = producesValidsOnGens3 func arbitrary shrink genvalidity-property-1.0.0.0/src/Test/Validity/GenValidity/Property.hs0000644000000000000000000000132114142332300024114 0ustar0000000000000000{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} -- | Tests for GenValidity instances module Test.Validity.GenValidity.Property ( genGeneratesValid, genGeneratesInvalid, ) where import Data.GenValidity import Test.QuickCheck import Test.Validity.Property.Utils -- | The given generator generates only valid data points genGeneratesValid :: forall a. (Show a, Validity a) => Gen a -> Property genGeneratesValid gen = forAll gen shouldBeValid -- | The given generator generates only invalid data points genGeneratesInvalid :: forall a. (Show a, Validity a) => Gen a -> Property genGeneratesInvalid gen = forAll gen shouldBeInvalid genvalidity-property-1.0.0.0/src/Test/Validity/Operations.hs0000644000000000000000000000065714146214612022220 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} -- | Properties of operations module Test.Validity.Operations ( module Test.Validity.Operations.Associativity, module Test.Validity.Operations.Commutativity, module Test.Validity.Operations.Identity, ) where import Test.Validity.Operations.Associativity import Test.Validity.Operations.Commutativity import Test.Validity.Operations.Identity genvalidity-property-1.0.0.0/src/Test/Validity/Operations/Associativity.hs0000644000000000000000000000221714146214612025045 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} module Test.Validity.Operations.Associativity ( associativeOnGens, associative, associativeOnArbitrary, ) where import Data.GenValidity import Test.Hspec import Test.QuickCheck -- | -- -- \[ -- Associative(\star) -- \quad\equiv\quad -- \forall a, b, c: -- (a \star b) \star c = a \star (b \star c) -- \] associativeOnGens :: (Show a, Eq a) => (a -> a -> a) -> Gen (a, a, a) -> ((a, a, a) -> [(a, a, a)]) -> Property associativeOnGens op gen s = forAllShrink gen s $ \(a, b, c) -> ((a `op` b) `op` c) `shouldBe` (a `op` (b `op` c)) -- | -- -- prop> associative ((*) :: Int -> Int -> Int) -- prop> associative ((+) :: Int -> Int -> Int) associative :: (Show a, Eq a, GenValid a) => (a -> a -> a) -> Property associative op = associativeOnGens op genValid shrinkValid -- | -- -- prop> associativeOnArbitrary ((*) :: Int -> Int -> Int) -- prop> associativeOnArbitrary ((+) :: Int -> Int -> Int) associativeOnArbitrary :: (Show a, Eq a, Arbitrary a) => (a -> a -> a) -> Property associativeOnArbitrary op = associativeOnGens op arbitrary shrink genvalidity-property-1.0.0.0/src/Test/Validity/Operations/Commutativity.hs0000644000000000000000000000233014146214612025064 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} module Test.Validity.Operations.Commutativity ( commutativeOnGens, commutative, commutativeOnArbitrary, ) where import Data.GenValidity import Test.Hspec import Test.QuickCheck -- | -- -- \[ -- Commutative(\star) -- \quad\equiv\quad -- \forall a, b: -- a \star b = b \star a -- \] commutativeOnGens :: (Show a, Show b, Eq b) => (a -> a -> b) -> Gen (a, a) -> ((a, a) -> [(a, a)]) -> Property commutativeOnGens op gen s = forAllShrink gen s $ \(a, b) -> (a `op` b) `shouldBe` (b `op` a) -- | -- -- prop> commutative ((+) :: Int -> Int -> Int) -- prop> commutative ((*) :: Int -> Int -> Int) commutative :: (Show a, Show b, Eq b, GenValid a) => (a -> a -> b) -> Property commutative op = commutativeOnGens op genValid shrinkValid -- | -- -- prop> commutativeOnArbitrary ((+) :: Int -> Int -> Int) -- prop> commutativeOnArbitrary ((*) :: Int -> Int -> Int) -- commutativeOnArbitrary :: -- (Show a, Eq a, Arbitrary a) => (a -> a -> a) -> Property commutativeOnArbitrary :: (Show a, Show b, Eq b, Arbitrary a) => (a -> a -> b) -> Property commutativeOnArbitrary op = commutativeOnGens op arbitrary shrink genvalidity-property-1.0.0.0/src/Test/Validity/Operations/Identity.hs0000644000000000000000000000777414146214612024020 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} module Test.Validity.Operations.Identity ( leftIdentityOnElemWithEquality, leftIdentityOnGenWithEquality, leftIdentityOnGen, leftIdentity, leftIdentityOnArbitrary, rightIdentityOnElemWithEquality, rightIdentityOnGenWithEquality, rightIdentityOnGen, rightIdentity, rightIdentityOnArbitrary, identityOnGen, identity, identityOnArbitrary, ) where import Data.GenValidity import Test.QuickCheck -- | -- -- \[ -- LeftIdentity(\star, \doteq, b) -- \quad\equiv\quad -- \forall a: (b \star a) \doteq a -- \] leftIdentityOnElemWithEquality :: -- | A binary operation (b -> a -> a) -> -- | An equality (a -> a -> Bool) -> -- | A candidate left-identity b -> -- | An element a -> Bool leftIdentityOnElemWithEquality op eq b a = (b `op` a) `eq` a leftIdentityOnGenWithEquality :: Show a => -- | A binary operation (b -> a -> a) -> -- | An equality (a -> a -> Bool) -> -- | A candidate left-identity b -> Gen a -> (a -> [a]) -> Property leftIdentityOnGenWithEquality op eq b gen s = forAllShrink gen s $ leftIdentityOnElemWithEquality op eq b leftIdentityOnGen :: (Show a, Eq a) => -- | A binary operation (b -> a -> a) -> -- | A candidate left-identity b -> Gen a -> (a -> [a]) -> Property leftIdentityOnGen op = leftIdentityOnGenWithEquality op (==) -- | -- -- prop> leftIdentity (flip ((^) :: Int -> Int -> Int)) 1 leftIdentity :: (Show a, Eq a, GenValid a) => (b -> a -> a) -> b -> Property leftIdentity op b = leftIdentityOnGen op b genValid shrinkValid -- | -- -- prop> leftIdentityOnArbitrary (flip ((^) :: Int -> Int -> Int)) 1 leftIdentityOnArbitrary :: (Show a, Eq a, Arbitrary a) => (b -> a -> a) -> b -> Property leftIdentityOnArbitrary op b = leftIdentityOnGen op b arbitrary shrink -- | -- -- \[ -- RightIdentity(\star, \doteq, b) -- \quad\equiv\quad -- \forall a: (a \star b) \doteq a -- \] rightIdentityOnElemWithEquality :: -- | A binary operation (a -> b -> a) -> -- | An equality (a -> a -> Bool) -> -- | A candidate right-identity b -> -- | An element a -> Bool rightIdentityOnElemWithEquality op eq b a = (a `op` b) `eq` a rightIdentityOnGenWithEquality :: Show a => -- | A binary operation (a -> b -> a) -> -- | An equality (a -> a -> Bool) -> -- | A candidate right-identity b -> Gen a -> (a -> [a]) -> Property rightIdentityOnGenWithEquality op eq b gen s = forAllShrink gen s $ rightIdentityOnElemWithEquality op eq b rightIdentityOnGen :: (Show a, Eq a) => -- | A binary operation (a -> b -> a) -> -- | A candidate right-identity b -> Gen a -> (a -> [a]) -> Property rightIdentityOnGen op = rightIdentityOnGenWithEquality op (==) -- | -- -- prop> rightIdentity ((^) :: Int -> Int -> Int) 1 rightIdentity :: (Show a, Eq a, GenValid a) => (a -> b -> a) -> b -> Property rightIdentity op b = rightIdentityOnGen op b genValid shrinkValid -- | -- -- prop> rightIdentityOnArbitrary ((^) :: Int -> Int -> Int) 1 rightIdentityOnArbitrary :: (Show a, Eq a, Arbitrary a) => (a -> b -> a) -> b -> Property rightIdentityOnArbitrary op b = rightIdentityOnGen op b arbitrary shrink -- | -- -- \[ -- Identity(\star, \doteq, b) -- \quad\equiv\quad -- LeftIdentity(\star, \doteq, b) \wedge RightIdentity(\star, \doteq, b) -- \] identityOnGen :: (Show a, Eq a) => (a -> a -> a) -> a -> Gen a -> (a -> [a]) -> Property identityOnGen op e gen s = leftIdentityOnGen op e gen s .&&. rightIdentityOnGen op e gen s -- | -- -- prop> identity ((*) :: Int -> Int -> Int) 1 -- prop> identity ((+) :: Int -> Int -> Int) 0 identity :: (Show a, Eq a, GenValid a) => (a -> a -> a) -> a -> Property identity op e = identityOnGen op e genValid shrinkValid -- | -- -- prop> identityOnArbitrary ((*) :: Int -> Int -> Int) 1 -- prop> identityOnArbitrary ((+) :: Int -> Int -> Int) 0 identityOnArbitrary :: (Show a, Eq a, Arbitrary a) => (a -> a -> a) -> a -> Property identityOnArbitrary op a = identityOnGen op a arbitrary shrink genvalidity-property-1.0.0.0/src/Test/Validity/Property.hs0000644000000000000000000001063214146214612021713 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} module Test.Validity.Property ( module Data.GenValidity, forAllValid, -- * Tests for GenValidity instances genGeneratesValid, -- * Standard tests involving functions -- ** Standard tests involving validity producesValidsOnGen, producesValid, producesValidsOnArbitrary, producesValidsOnGens2, producesValid2, producesValidsOnArbitrary2, producesValidsOnGens3, producesValid3, producesValidsOnArbitrary3, -- ** Standard tests involving functions that can fail CanFail (..), succeedsOnGen, succeeds, succeedsOnArbitrary, succeedsOnGens2, succeeds2, succeedsOnArbitrary2, failsOnGen, failsOnGens2, validIfSucceedsOnGen, validIfSucceedsOnArbitrary, validIfSucceeds, validIfSucceedsOnGens2, validIfSucceeds2, validIfSucceedsOnArbitrary2, validIfSucceedsOnGens3, validIfSucceeds3, validIfSucceedsOnArbitrary3, -- ** Standard tests involving equivalence of functions -- *** Simple functions -- **** One argument equivalentOnGen, equivalent, equivalentOnArbitrary, -- **** Two arguments equivalentOnGens2, equivalent2, equivalentOnArbitrary2, -- **** Three arguments equivalentOnGens3, equivalent3, equivalentOnArbitrary3, -- *** First function can fail -- **** One argument equivalentWhenFirstSucceedsOnGen, equivalentWhenFirstSucceeds, equivalentWhenFirstSucceedsOnArbitrary, -- **** Two arguments equivalentWhenFirstSucceedsOnGens2, equivalentWhenFirstSucceeds2, equivalentWhenFirstSucceedsOnArbitrary2, -- *** Second function can fail -- **** One argument equivalentWhenSecondSucceedsOnGen, equivalentWhenSecondSucceeds, equivalentWhenSecondSucceedsOnArbitrary, -- **** Two arguments equivalentWhenSecondSucceedsOnGens2, equivalentWhenSecondSucceeds2, equivalentWhenSecondSucceedsOnArbitrary2, -- *** Both functions can fail -- **** One argument equivalentWhenSucceedOnGen, equivalentWhenSucceed, equivalentWhenSucceedOnArbitrary, -- **** Two arguments equivalentWhenSucceedOnGens2, equivalentWhenSucceed2, equivalentWhenSucceedOnArbitrary2, -- ** Standard tests involving inverse functions inverseFunctionsOnGen, inverseFunctions, inverseFunctionsOnArbitrary, inverseFunctionsIfFirstSucceedsOnGen, inverseFunctionsIfFirstSucceeds, inverseFunctionsIfFirstSucceedsOnArbitrary, inverseFunctionsIfSecondSucceedsOnGen, inverseFunctionsIfSecondSucceeds, inverseFunctionsIfSecondSucceedsOnArbitrary, inverseFunctionsIfSucceedOnGen, inverseFunctionsIfSucceed, inverseFunctionsIfSucceedOnArbitrary, -- ** Properties involving idempotence idempotentOnGen, idempotent, idempotentOnArbitrary, -- * Properties of relations -- ** Reflexivity reflexiveOnElem, reflexivityOnGen, reflexivity, reflexivityOnArbitrary, -- ** Transitivity transitiveOnElems, transitivityOnGens, transitivity, transitivityOnArbitrary, -- ** Antisymmetry antisymmetricOnElemsWithEquality, antisymmetryOnGensWithEquality, antisymmetryOnGens, antisymmetry, antisymmetryOnArbitrary, -- ** Antireflexivity antireflexiveOnElem, antireflexivityOnGen, antireflexivity, antireflexivityOnArbitrary, -- ** Symmetry symmetricOnElems, symmetryOnGens, symmetry, symmetryOnArbitrary, -- * Properties of operations -- ** Identity element -- *** Left Identity leftIdentityOnElemWithEquality, leftIdentityOnGenWithEquality, leftIdentityOnGen, leftIdentity, leftIdentityOnArbitrary, -- *** Right Identity rightIdentityOnElemWithEquality, rightIdentityOnGenWithEquality, rightIdentityOnGen, rightIdentity, rightIdentityOnArbitrary, -- *** Identity identityOnGen, identity, identityOnArbitrary, -- ** Associativity associativeOnGens, associative, associativeOnArbitrary, -- ** Commutativity commutativeOnGens, commutative, commutativeOnArbitrary, ) where import Data.GenValidity import Test.Validity.Functions import Test.Validity.GenValidity.Property import Test.Validity.Operations import Test.Validity.Property.Utils import Test.Validity.Relations import Test.Validity.Types genvalidity-property-1.0.0.0/src/Test/Validity/Property/Utils.hs0000644000000000000000000000234714146214612023017 0ustar0000000000000000module Test.Validity.Property.Utils ( forAllValid, shouldBeValid, shouldBeInvalid, (<==>), (===>), ) where import Data.GenValidity import Test.Hspec import Test.QuickCheck import Text.Show.Pretty (ppShow) forAllValid :: (Show a, GenValid a, Testable prop) => (a -> prop) -> Property forAllValid = forAllShrink genValid shrinkValid (===>) :: Bool -> Bool -> Bool (===>) a b = not a || b (<==>) :: Bool -> Bool -> Bool (<==>) a b = a ===> b && b ===> a shouldBeValid :: (Show a, Validity a) => a -> Expectation shouldBeValid a = case prettyValidate a of Right _ -> pure () Left err -> expectationFailure $ unlines [ "'validate' reported this value to be invalid: ", show a, "pretty version:", ppShow a, "with explanation:", err, "" ] shouldBeInvalid :: (Show a, Validity a) => a -> Expectation shouldBeInvalid a = case prettyValidate a of Right _ -> expectationFailure $ unlines [ "'validate' reported this value to be valid: ", show a, "pretty version:", ppShow a, "where we expected it to be invalid" ] Left _ -> pure () genvalidity-property-1.0.0.0/src/Test/Validity/Relations.hs0000644000000000000000000000114114146214612022022 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} -- | Properties of relations module Test.Validity.Relations ( module Test.Validity.Relations.Antireflexivity, module Test.Validity.Relations.Antisymmetry, module Test.Validity.Relations.Reflexivity, module Test.Validity.Relations.Symmetry, module Test.Validity.Relations.Transitivity, ) where import Test.Validity.Relations.Antireflexivity import Test.Validity.Relations.Antisymmetry import Test.Validity.Relations.Reflexivity import Test.Validity.Relations.Symmetry import Test.Validity.Relations.Transitivity genvalidity-property-1.0.0.0/src/Test/Validity/Relations/Antireflexivity.hs0000644000000000000000000000253414146214612025217 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} module Test.Validity.Relations.Antireflexivity ( antireflexiveOnElem, antireflexivityOnGen, antireflexivity, antireflexivityOnArbitrary, ) where import Data.GenValidity import Test.QuickCheck -- | -- -- \[ -- Antireflexive(\prec) -- \quad\equiv\quad -- \forall a: \neg (a \prec a) -- \] antireflexiveOnElem :: -- | A relation (a -> a -> Bool) -> -- | An element a -> Bool antireflexiveOnElem func a = not $ func a a antireflexivityOnGen :: Show a => (a -> a -> Bool) -> Gen a -> (a -> [a]) -> Property antireflexivityOnGen func gen s = forAllShrink gen s $ antireflexiveOnElem func -- | -- -- prop> antireflexivity ((<) :: Int -> Int -> Bool) -- prop> antireflexivity ((/=) :: Int -> Int -> Bool) -- prop> antireflexivity ((>) :: Int -> Int -> Bool) antireflexivity :: (Show a, GenValid a) => (a -> a -> Bool) -> Property antireflexivity func = antireflexivityOnGen func genValid shrinkValid -- | -- -- prop> antireflexivityOnArbitrary ((<) :: Int -> Int -> Bool) -- prop> antireflexivityOnArbitrary ((/=) :: Int -> Int -> Bool) -- prop> antireflexivityOnArbitrary ((>) :: Int -> Int -> Bool) antireflexivityOnArbitrary :: (Show a, Arbitrary a) => (a -> a -> Bool) -> Property antireflexivityOnArbitrary func = antireflexivityOnGen func arbitrary shrink genvalidity-property-1.0.0.0/src/Test/Validity/Relations/Antisymmetry.hs0000644000000000000000000000505414146214612024536 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} module Test.Validity.Relations.Antisymmetry ( antisymmetricOnElemsWithEquality, antisymmetryOnGensWithEquality, antisymmetryOnGens, antisymmetry, antisymmetryOnArbitrary, ) where import Data.GenValidity import Test.QuickCheck import Test.Validity.Property.Utils -- | -- -- \[ -- Antisymmetric(\prec, \doteq) -- \quad\equiv\quad -- \forall a, b: ((a \prec b) \wedge (b \prec a)) \Rightarrow (a \doteq b) -- \] antisymmetricOnElemsWithEquality :: -- | A relation (a -> a -> Bool) -> -- | An equivalence relation (a -> a -> Bool) -> a -> -- | Two elements a -> Bool antisymmetricOnElemsWithEquality func eq a b = (func a b && func b a) ===> (a `eq` b) antisymmetryOnGensWithEquality :: Show a => (a -> a -> Bool) -> Gen (a, a) -> (a -> a -> Bool) -> (a -> [a]) -> Property antisymmetryOnGensWithEquality func gen eq s = forAllShrink gen (shrinkT2 s) $ uncurry $ antisymmetricOnElemsWithEquality func eq antisymmetryOnGens :: (Show a, Eq a) => (a -> a -> Bool) -> Gen (a, a) -> (a -> [a]) -> Property antisymmetryOnGens func gen = antisymmetryOnGensWithEquality func gen (==) -- | -- -- prop> antisymmetry ((>) :: Int -> Int -> Bool) -- prop> antisymmetry ((>=) :: Int -> Int -> Bool) -- prop> antisymmetry ((<=) :: Int -> Int -> Bool) -- prop> antisymmetry ((<) :: Int -> Int -> Bool) -- prop> antisymmetry (Data.List.isPrefixOf :: [Int] -> [Int] -> Bool) -- prop> antisymmetry (Data.List.isSuffixOf :: [Int] -> [Int] -> Bool) -- prop> antisymmetry (Data.List.isInfixOf :: [Int] -> [Int] -> Bool) -- prop> antisymmetry ((\x y -> even x && odd y) :: Int -> Int -> Bool) antisymmetry :: (Show a, Eq a, GenValid a) => (a -> a -> Bool) -> Property antisymmetry func = antisymmetryOnGens func genValid shrinkValid -- | -- -- prop> antisymmetryOnArbitrary ((>) :: Int -> Int -> Bool) -- prop> antisymmetryOnArbitrary ((>=) :: Int -> Int -> Bool) -- prop> antisymmetryOnArbitrary ((<=) :: Int -> Int -> Bool) -- prop> antisymmetryOnArbitrary ((<) :: Int -> Int -> Bool) -- prop> antisymmetryOnArbitrary (Data.List.isPrefixOf :: [Int] -> [Int] -> Bool) -- prop> antisymmetryOnArbitrary (Data.List.isSuffixOf :: [Int] -> [Int] -> Bool) -- prop> antisymmetryOnArbitrary (Data.List.isInfixOf :: [Int] -> [Int] -> Bool) -- prop> antisymmetryOnArbitrary ((\x y -> even x && odd y) :: Int -> Int -> Bool) antisymmetryOnArbitrary :: (Show a, Eq a, Arbitrary a) => (a -> a -> Bool) -> Property antisymmetryOnArbitrary func = antisymmetryOnGens func arbitrary shrink genvalidity-property-1.0.0.0/src/Test/Validity/Relations/Reflexivity.hs0000644000000000000000000000327214146214612024343 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} module Test.Validity.Relations.Reflexivity ( reflexiveOnElem, reflexivityOnGen, reflexivity, reflexivityOnArbitrary, ) where import Data.GenValidity import Test.QuickCheck -- | -- -- \[ -- Reflexive(\prec) -- \quad\equiv\quad -- \forall a: (a \prec a) -- \] reflexiveOnElem :: -- | A relation (a -> a -> Bool) -> -- | An element a -> Bool reflexiveOnElem func a = func a a reflexivityOnGen :: Show a => (a -> a -> Bool) -> Gen a -> (a -> [a]) -> Property reflexivityOnGen func gen s = forAllShrink gen s $ reflexiveOnElem func -- | -- -- prop> reflexivity ((<=) :: Int -> Int -> Bool) -- prop> reflexivity ((==) :: Int -> Int -> Bool) -- prop> reflexivity ((>=) :: Int -> Int -> Bool) -- prop> reflexivity (Data.List.isPrefixOf :: [Int] -> [Int] -> Bool) -- prop> reflexivity (Data.List.isSuffixOf :: [Int] -> [Int] -> Bool) -- prop> reflexivity (Data.List.isInfixOf :: [Int] -> [Int] -> Bool) reflexivity :: (Show a, GenValid a) => (a -> a -> Bool) -> Property reflexivity func = reflexivityOnGen func genValid shrinkValid -- | -- -- prop> reflexivityOnArbitrary ((<=) :: Int -> Int -> Bool) -- prop> reflexivityOnArbitrary ((==) :: Int -> Int -> Bool) -- prop> reflexivityOnArbitrary ((>=) :: Int -> Int -> Bool) -- prop> reflexivityOnArbitrary (Data.List.isPrefixOf :: [Int] -> [Int] -> Bool) -- prop> reflexivityOnArbitrary (Data.List.isSuffixOf :: [Int] -> [Int] -> Bool) -- prop> reflexivityOnArbitrary (Data.List.isInfixOf :: [Int] -> [Int] -> Bool) reflexivityOnArbitrary :: (Show a, Arbitrary a) => (a -> a -> Bool) -> Property reflexivityOnArbitrary func = reflexivityOnGen func arbitrary shrink genvalidity-property-1.0.0.0/src/Test/Validity/Relations/Symmetry.hs0000644000000000000000000000233114146214612023655 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} module Test.Validity.Relations.Symmetry ( symmetricOnElems, symmetryOnGens, symmetry, symmetryOnArbitrary, ) where import Data.GenValidity import Test.QuickCheck import Test.Validity.Property.Utils -- | -- -- \[ -- Symmetric(\prec) -- \quad\equiv\quad -- \forall a, b: (a \prec b) \Leftrightarrow (b \prec a) -- \] symmetricOnElems :: -- | A relation (a -> a -> Bool) -> a -> -- | Two elements a -> Bool symmetricOnElems func a b = func a b <==> func b a symmetryOnGens :: Show a => (a -> a -> Bool) -> Gen (a, a) -> (a -> [a]) -> Property symmetryOnGens func gen s = forAllShrink gen (shrinkT2 s) $ uncurry $ symmetricOnElems func -- | -- -- prop> symmetry ((==) :: Int -> Int -> Bool) -- prop> symmetry ((/=) :: Int -> Int -> Bool) symmetry :: (Show a, GenValid a) => (a -> a -> Bool) -> Property symmetry func = symmetryOnGens func genValid shrinkValid -- | -- -- prop> symmetryOnArbitrary ((==) :: Int -> Int -> Bool) -- prop> symmetryOnArbitrary ((/=) :: Int -> Int -> Bool) symmetryOnArbitrary :: (Show a, Arbitrary a) => (a -> a -> Bool) -> Property symmetryOnArbitrary func = symmetryOnGens func arbitrary shrink genvalidity-property-1.0.0.0/src/Test/Validity/Relations/Transitivity.hs0000644000000000000000000000416014146214612024537 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} module Test.Validity.Relations.Transitivity ( transitiveOnElems, transitivityOnGens, transitivity, transitivityOnArbitrary, ) where import Data.GenValidity import Test.QuickCheck import Test.Validity.Property.Utils -- | -- -- \[ -- Transitive(\prec) -- \quad\equiv\quad -- \forall a, b, c: ((a \prec b) \wedge (b \prec c)) \Rightarrow (a \prec c) -- \] transitiveOnElems :: -- | A relation (a -> a -> Bool) -> a -> a -> -- | Three elements a -> Bool transitiveOnElems func a b c = (func a b && func b c) ===> func a c transitivityOnGens :: Show a => (a -> a -> Bool) -> Gen (a, a, a) -> (a -> [a]) -> Property transitivityOnGens func gen s = forAllShrink gen (shrinkT3 s) $ \(a, b, c) -> transitiveOnElems func a b c -- | -- -- prop> transitivity ((>) :: Int -> Int -> Bool) -- prop> transitivity ((>=) :: Int -> Int -> Bool) -- prop> transitivity ((==) :: Int -> Int -> Bool) -- prop> transitivity ((<=) :: Int -> Int -> Bool) -- prop> transitivity ((<) :: Int -> Int -> Bool) -- prop> transitivity (Data.List.isPrefixOf :: [Int] -> [Int] -> Bool) -- prop> transitivity (Data.List.isSuffixOf :: [Int] -> [Int] -> Bool) -- prop> transitivity (Data.List.isInfixOf :: [Int] -> [Int] -> Bool) transitivity :: (Show a, GenValid a) => (a -> a -> Bool) -> Property transitivity func = transitivityOnGens func genValid shrinkValid -- | -- -- prop> transitivityOnArbitrary ((>) :: Int -> Int -> Bool) -- prop> transitivityOnArbitrary ((>=) :: Int -> Int -> Bool) -- prop> transitivityOnArbitrary ((==) :: Int -> Int -> Bool) -- prop> transitivityOnArbitrary ((<=) :: Int -> Int -> Bool) -- prop> transitivityOnArbitrary ((<) :: Int -> Int -> Bool) -- prop> transitivityOnArbitrary (Data.List.isPrefixOf :: [Int] -> [Int] -> Bool) -- prop> transitivityOnArbitrary (Data.List.isSuffixOf :: [Int] -> [Int] -> Bool) -- prop> transitivityOnArbitrary (Data.List.isInfixOf :: [Int] -> [Int] -> Bool) transitivityOnArbitrary :: (Show a, Arbitrary a) => (a -> a -> Bool) -> Property transitivityOnArbitrary func = transitivityOnGens func arbitrary shrink genvalidity-property-1.0.0.0/src/Test/Validity/Shrinking/Property.hs0000644000000000000000000000741114146214612023650 0ustar0000000000000000{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} -- | Tests for shrinking functions module Test.Validity.Shrinking.Property ( shrinkPreservesValidOnGenValid, shrinkValidPreservesValid, shrinkingStaysValid, shrinkingStaysValidWithLimit, shrinkingPreserves, shrinkingPreservesWithLimit, shrinkDoesNotShrinkToItself, shrinkDoesNotShrinkToItselfWithLimit, shrinkDoesNotShrinkToItselfOnValid, shrinkDoesNotShrinkToItselfOnValidWithLimit, doesNotShrinkToItself, doesNotShrinkToItselfWithLimit, ) where import Data.GenValidity import Test.QuickCheck -- | -- -- prop> shrinkPreservesValidOnGenValid ((:[]) :: Int -> [Int]) shrinkPreservesValidOnGenValid :: forall a. (Show a, GenValid a) => (a -> [a]) -> Property shrinkPreservesValidOnGenValid = shrinkingStaysValid genValid -- | -- -- prop> shrinkValidPreservesValid (pure 5 :: Gen Rational) shrinkValidPreservesValid :: forall a. (Show a, GenValid a) => Gen a -> Property shrinkValidPreservesValid gen = shrinkingStaysValid gen shrinkValid -- | -- -- prop> shrinkingStaysValid (pure 5 :: Gen Double) (\d -> [d - 1, d - 2]) shrinkingStaysValid :: forall a. (Show a, Validity a) => Gen a -> (a -> [a]) -> Property shrinkingStaysValid gen s = shrinkingPreserves gen s isValid -- | -- -- prop> shrinkingStaysValidWithLimit (pure 5 :: Gen Double) (\d -> [d - 1, read "NaN"]) 1 shrinkingStaysValidWithLimit :: forall a. (Show a, Validity a) => Gen a -> (a -> [a]) -> Int -> Property shrinkingStaysValidWithLimit gen s l = shrinkingPreservesWithLimit gen s l isValid -- | -- -- prop> shrinkingPreserves (pure 5 :: Gen Int) (:[]) (== 5) shrinkingPreserves :: forall a. Show a => Gen a -> (a -> [a]) -> (a -> Bool) -> Property shrinkingPreserves gen s p = forAll gen $ \d -> not (p d) || all p (s d) -- | -- -- prop> shrinkingPreservesWithLimit (pure 4) (:[]) 100 (== 4) shrinkingPreservesWithLimit :: forall a. Show a => Gen a -> (a -> [a]) -> Int -> (a -> Bool) -> Property shrinkingPreservesWithLimit gen s l p = forAll gen $ \d -> not (p d) || all p (take l $ s d) -- | -- -- prop> shrinkDoesNotShrinkToItself (shrinkValid :: Double -> [Double]) shrinkDoesNotShrinkToItself :: forall a. (Show a, Eq a, GenValid a) => (a -> [a]) -> Property shrinkDoesNotShrinkToItself = doesNotShrinkToItself genValid -- | -- -- prop> shrinkDoesNotShrinkToItselfWithLimit (shrinkValid :: Double -> [Double]) 100 shrinkDoesNotShrinkToItselfWithLimit :: forall a. (Show a, Eq a, GenValid a) => (a -> [a]) -> Int -> Property shrinkDoesNotShrinkToItselfWithLimit = doesNotShrinkToItselfWithLimit genValid -- | -- -- prop> shrinkDoesNotShrinkToItselfOnValid (shrinkValid :: Rational -> [Rational]) shrinkDoesNotShrinkToItselfOnValid :: forall a. (Show a, Eq a, GenValid a) => (a -> [a]) -> Property shrinkDoesNotShrinkToItselfOnValid = doesNotShrinkToItself genValid -- | -- -- prop> shrinkDoesNotShrinkToItselfOnValidWithLimit (shrinkValid :: Rational -> [Rational]) 100 shrinkDoesNotShrinkToItselfOnValidWithLimit :: forall a. (Show a, Eq a, GenValid a) => (a -> [a]) -> Int -> Property shrinkDoesNotShrinkToItselfOnValidWithLimit = doesNotShrinkToItselfWithLimit genValid -- | -- -- prop> doesNotShrinkToItself (pure 5 :: Gen Double) shrinkValid doesNotShrinkToItself :: forall a. (Show a, Eq a) => Gen a -> (a -> [a]) -> Property doesNotShrinkToItself gen s = forAll gen $ \a -> notElem a $ s a -- | -- -- prop> doesNotShrinkToItselfWithLimit (pure 5 :: Gen Double) shrinkValid 100 doesNotShrinkToItselfWithLimit :: forall a. (Show a, Eq a) => Gen a -> (a -> [a]) -> Int -> Property doesNotShrinkToItselfWithLimit gen s l = forAll gen $ \a -> notElem a $ take l $ s a genvalidity-property-1.0.0.0/src/Test/Validity/Types.hs0000644000000000000000000000113714142324065021173 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} module Test.Validity.Types ( CanFail (..), ) where -- | A class of types that are the result of functions that can fail class CanFail f where hasFailed :: f a -> Bool resultIfSucceeded :: f a -> Maybe a instance CanFail Maybe where hasFailed Nothing = True hasFailed _ = False resultIfSucceeded Nothing = Nothing resultIfSucceeded (Just r) = Just r instance CanFail (Either e) where hasFailed (Left _) = True hasFailed _ = False resultIfSucceeded (Left _) = Nothing resultIfSucceeded (Right r) = Just r genvalidity-property-1.0.0.0/test/Spec.hs0000644000000000000000000000005414142324034016436 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} genvalidity-property-1.0.0.0/test/Test/Validity/Operations/CommutativitySpec.hs0000644000000000000000000000166414146214612026100 0ustar0000000000000000{-# LANGUAGE TypeApplications #-} module Test.Validity.Operations.CommutativitySpec ( spec, ) where import Data.GenValidity (GenValid) import Test.Hspec import Test.QuickCheck import Test.Validity.Operations.Commutativity (commutative) spec :: Spec spec = do describe "commutative" $ do specify "+ is commutative" $ commutative @Int (+) specify "* is commutative" $ commutative @Int (*) specify "dot product is commutative" $ commutative dotProduct specify "- is not commutative" $ notCommmutative @Int (-) specify "cross product is not commutative" $ notCommmutative crossProduct notCommmutative :: (Show a, Show b, Eq b, GenValid a) => (a -> a -> b) -> Property notCommmutative op = expectFailure (commutative op) type Point = (Int, Int) dotProduct :: Point -> Point -> Int dotProduct (x1, y1) (x2, y2) = x1 * x2 + y1 * y2 crossProduct :: Point -> Point -> Int crossProduct (x1, y1) (x2, y2) = x1 * y2 - x2 * y1 genvalidity-property-1.0.0.0/LICENSE0000644000000000000000000000210414146214612015240 0ustar0000000000000000The MIT License (MIT) Copyright (c) 2016-2021 Tom Sydney Kerckhove Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. genvalidity-property-1.0.0.0/genvalidity-property.cabal0000644000000000000000000000436714146214612021435 0ustar0000000000000000cabal-version: 1.12 -- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack name: genvalidity-property version: 1.0.0.0 synopsis: Standard properties for functions on `Validity` types category: Testing homepage: https://github.com/NorfairKing/validity#readme bug-reports: https://github.com/NorfairKing/validity/issues author: Tom Sydney Kerckhove maintainer: syd@cs-syd.eu copyright: Copyright: (c) 2016-2021 Tom Sydney Kerckhove license: MIT license-file: LICENSE build-type: Simple extra-source-files: LICENSE CHANGELOG.md source-repository head type: git location: https://github.com/NorfairKing/validity library exposed-modules: Test.Validity.Functions Test.Validity.Functions.CanFail Test.Validity.Functions.Equivalence Test.Validity.Functions.Idempotence Test.Validity.Functions.Inverse Test.Validity.Functions.Validity Test.Validity.GenValidity.Property Test.Validity.Operations Test.Validity.Operations.Associativity Test.Validity.Operations.Commutativity Test.Validity.Operations.Identity Test.Validity.Property Test.Validity.Property.Utils Test.Validity.Relations Test.Validity.Relations.Antireflexivity Test.Validity.Relations.Antisymmetry Test.Validity.Relations.Reflexivity Test.Validity.Relations.Symmetry Test.Validity.Relations.Transitivity Test.Validity.Shrinking.Property Test.Validity.Types other-modules: Paths_genvalidity_property hs-source-dirs: src ghc-options: -Wall -fwarn-redundant-constraints build-depends: QuickCheck , base >=4.7 && <5 , genvalidity >=1.0 , hspec >=2.1 , pretty-show , validity >=0.9 default-language: Haskell2010 test-suite genvalidity-property-test type: exitcode-stdio-1.0 main-is: Spec.hs other-modules: Test.Validity.Operations.CommutativitySpec Paths_genvalidity_property hs-source-dirs: test ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall build-depends: QuickCheck , base >=4.7 && <5 , genvalidity , genvalidity-property , hspec default-language: Haskell2010 genvalidity-property-1.0.0.0/CHANGELOG.md0000644000000000000000000000273114146214612016052 0ustar0000000000000000# Changelog ## [1.0.0.0] - 2021-11-20 ### Changed * Compatibility with `genvalidity >= 1.0.0.0` * Renamed every combinator that ends in `OnValid` (or similar) to not have that suffix anymore. ### Removed * Every combinator that relates to unchecked or invalid values. ## [0.5.0.2] - 2020-02-10 ### Changed * Removed the doctests * Improved the cabal file ## [0.5.0.1] - 2019-09-23 ### Changed * Removed a redundant import to have a clean warning-free build ## [0.5.0.0] - 2019-09-23 ### Changed * Started using `pretty-show` for the output of `validIfSucceeds`, `validIfSucceedsOnGens2` and `validIfSucceedsOnValids3` * Started using `pretty-show` for the output of `shouldBeValid` and `shouldBeInvalid`. * Gave `genGeneratesValid` and `genGeneratesInvalid` much nicer output. * Removed nonsense shrinking from `genGeneratesValid` and `genGeneratesInvalid`. ## [0.4.0.0] - 2019-03-08 ### Changed * Compatibility with genvalidity >=0.8 ## [0.3.0.0] - 2018-11-07 ### Changed * Compatibility with validity >=0.9 and genvalidity >= 0.7 ## [0.2.1.1] - 2018-10-06 ### Added * `shrinkDoesNotShrinkToItself` * `shrinkDoesNotShrinkToItselfWithLimit` * `shrinkDoesNotShrinkToItselfOnValid` * `shrinkDoesNotShrinkToItselfOnValidWithLimit` * `shrinkDoesNotShrinkToItselfOnInvalid` * `shrinkDoesNotShrinkToItselfOnInvalidWithLimit` * `doesNotShrinkToItself` * `doesNotShrinkToItselfWithLimit` ### Changed * exported `shrinkingPreservesWithLimit` from `Test.Validity.Shrinking.Property`