genvalidity-hspec-1.0.0.3/src/0000755000000000000000000000000014506460037014252 5ustar0000000000000000genvalidity-hspec-1.0.0.3/src/Test/0000755000000000000000000000000014506460037015171 5ustar0000000000000000genvalidity-hspec-1.0.0.3/src/Test/Validity/0000755000000000000000000000000014507256377016771 5ustar0000000000000000genvalidity-hspec-1.0.0.3/test/0000755000000000000000000000000014506460037014442 5ustar0000000000000000genvalidity-hspec-1.0.0.3/test/Test/0000755000000000000000000000000014506460037015361 5ustar0000000000000000genvalidity-hspec-1.0.0.3/test/Test/Validity/0000755000000000000000000000000014506460037017146 5ustar0000000000000000genvalidity-hspec-1.0.0.3/src/Test/Validity.hs0000644000000000000000000001402114506460037017310 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} -- | To use the 'Spec' functions in this module, you will need @TypeApplications@. -- -- -- The most interesting functions in this module for most uses are: -- -- * 'genValidSpec' -- * 'eqSpec' -- * 'ordSpec' -- * 'producesValidsOnValids' -- * 'forAllValid' -- * 'shouldBeValid' module Test.Validity ( -- * Writing properties -- ** Cheap generation with shrinking forAllValid, -- ** Cheap assertions shouldBeValid, shouldBeInvalid, -- * Tests for GenValidity instances genValidSpec, genValidGeneratesValid, genGeneratesValid, shrinkValidSpec, shrinkValidSpecWithLimit, shrinkValidPreservesValidOnGenValid, shrinkPreservesValidOnGenValid, shrinkValidPreservesValid, shrinkingStaysValid, shrinkingPreserves, -- * Tests for Arbitrary instances involving Validity arbitrarySpec, arbitraryGeneratesOnlyValid, -- * 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, -- * Show and Read properties showReadSpec, showReadSpecOnArbitrary, showReadSpecOnGen, -- * Eq properties eqSpec, eqSpecOnArbitrary, eqSpecOnGen, -- * Ord properties ordSpecOnGen, ordSpec, ordSpecOnArbitrary, -- * Monoid properties monoidSpec, monoidSpecOnArbitrary, monoidSpecOnGen, -- * Functor properties functorSpec, functorSpecOnArbitrary, functorSpecOnGens, -- * Applicative properties applicativeSpec, applicativeSpecOnArbitrary, applicativeSpecOnGens, -- * Monad properties monadSpec, monadSpecOnArbitrary, monadSpecOnGens, -- * Re-exports module Data.GenValidity, ) where import Data.GenValidity import Test.Validity.Applicative import Test.Validity.Arbitrary import Test.Validity.Eq import Test.Validity.Functions import Test.Validity.Functor import Test.Validity.GenValidity import Test.Validity.Monad import Test.Validity.Monoid import Test.Validity.Operations import Test.Validity.Ord import Test.Validity.Property import Test.Validity.Show import Test.Validity.Shrinking import Test.Validity.Utils genvalidity-hspec-1.0.0.3/src/Test/Validity/Applicative.hs0000644000000000000000000001726714507256377021603 0ustar0000000000000000{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} -- | Applicative properties -- -- You will need @TypeApplications@ to use these. module Test.Validity.Applicative ( applicativeSpec, applicativeSpecOnArbitrary, applicativeSpecOnGens, ) where import Data.Data import Data.GenValidity import Data.Kind import GHC.Stack import Test.Hspec import Test.QuickCheck import Test.Validity.Functions import Test.Validity.Utils {-# ANN module "HLint: ignore Avoid lambda" #-} pureTypeStr :: forall (f :: Type -> Type). (Typeable f) => String pureTypeStr = unwords ["pure", "::", "a", "->", nameOf @f, "a"] seqTypeStr :: forall (f :: Type -> Type). (Typeable f) => String seqTypeStr = unwords [ "(<*>)", "::", nameOf @f, "(a", "->", "b)", "->", nameOf @f, "a", "->", nameOf @f, "b" ] seqrTypeStr :: forall (f :: Type -> Type). (Typeable f) => String seqrTypeStr = unwords [ "(*>)", "::", nameOf @f, "a", "->", nameOf @f, "b", "->", nameOf @f, "b" ] seqlTypeStr :: forall (f :: Type -> Type). (Typeable f) => String seqlTypeStr = unwords [ "(<*)", "::", nameOf @f, "a", "->", nameOf @f, "b", "->", nameOf @f, "a" ] -- | Standard test spec for properties of Applicative instances for values generated with GenValid instances -- -- Example usage: -- -- > applicativeSpecOnArbitrary @[] applicativeSpec :: forall (f :: Type -> Type). ( HasCallStack, Eq (f Int), Show (f Int), Applicative f, Typeable f, GenValid (f Int) ) => Spec applicativeSpec = withFrozenCallStack $ applicativeSpecWithInts @f genValid -- | Standard test spec for properties of Applicative instances for values generated with Arbitrary instances -- -- Example usage: -- -- > applicativeSpecOnArbitrary @[] applicativeSpecOnArbitrary :: forall (f :: Type -> Type). ( HasCallStack, Eq (f Int), Show (f Int), Applicative f, Typeable f, Arbitrary (f Int) ) => Spec applicativeSpecOnArbitrary = withFrozenCallStack $ applicativeSpecWithInts @f arbitrary applicativeSpecWithInts :: forall (f :: Type -> Type). (HasCallStack, Show (f Int), Eq (f Int), Applicative f, Typeable f) => Gen (f Int) -> Spec applicativeSpecWithInts gen = withFrozenCallStack $ applicativeSpecOnGens @f @Int genValid "int" gen (unwords [nameOf @f, "of ints"]) gen (unwords [nameOf @f, "of ints"]) ((+) <$> genValid) "increments" (pure <$> ((+) <$> genValid)) (unwords [nameOf @f, "of increments"]) (pure <$> ((*) <$> genValid)) (unwords [nameOf @f, "of scalings"]) -- | Standard test spec for properties of Applicative instances for values generated by given generators (and names for those generator). -- -- Unless you are building a specific regression test, you probably want to use the other 'applicativeSpec' functions. -- -- Example usage: -- -- > applicativeSpecOnGens -- > @Maybe -- > @String -- > (pure "ABC") -- > "ABC" -- > (Just <$> pure "ABC") -- > "Just an ABC" -- > (pure Nothing) -- > "purely Nothing" -- > ((++) <$> genValid) -- > "prepends" -- > (pure <$> ((++) <$> genValid)) -- > "prepends in a Just" -- > (pure <$> (flip (++) <$> genValid)) -- > "appends in a Just" applicativeSpecOnGens :: forall (f :: Type -> Type) (a :: Type) (b :: Type) (c :: Type). ( HasCallStack, Show a, Show (f a), Eq (f a), Show (f b), Eq (f b), Show (f c), Eq (f c), Applicative f, Typeable f, Typeable a, Typeable b, Typeable c ) => Gen a -> String -> Gen (f a) -> String -> Gen (f b) -> String -> Gen (a -> b) -> String -> Gen (f (a -> b)) -> String -> Gen (f (b -> c)) -> String -> Spec applicativeSpecOnGens gena genaname gen genname genb genbname genfa genfaname genffa genffaname genffb genffbname = withFrozenCallStack $ parallel $ describe ("Applicative " ++ nameOf @f) $ do describe (unwords [pureTypeStr @f, "and", seqTypeStr @f]) $ do it ( unwords [ "satisfy the identity law: 'pure id <*> v = v' for", genDescr @(f a) genname ] ) $ equivalentOnGen (pure id <*>) id gen shrinkNothing it ( unwords [ "satisfy the composition law: 'pure (.) <*> u <*> v <*> w = u <*> (v <*> w)' for", genDescr @(f (b -> c)) genffbname, "composed with", genDescr @(f (a -> b)) genffaname, "and applied to", genDescr @(f a) genname ] ) $ equivalentOnGens3 ( \(Anon u) (Anon v) w -> pure (.) <*> (u :: f (b -> c)) <*> (v :: f (a -> b)) <*> (w :: f a) :: f c ) (\(Anon u) (Anon v) w -> u <*> (v <*> w) :: f c) ((,,) <$> (Anon <$> genffb) <*> (Anon <$> genffa) <*> gen) shrinkNothing it ( unwords [ "satisfy the homomorphism law: 'pure f <*> pure x = pure (f x)' for", genDescr @(a -> b) genfaname, "sequenced with", genDescr @a genaname ] ) $ equivalentOnGens2 (\(Anon f) x -> pure f <*> pure x :: f b) (\(Anon f) x -> pure $ f x :: f b) ((,) <$> (Anon <$> genfa) <*> gena) shrinkNothing it ( unwords [ "satisfy the interchange law: 'u <*> pure y = pure ($ y) <*> u' for", genDescr @(f (a -> b)) genffaname, "sequenced with", genDescr @a genaname ] ) $ equivalentOnGens2 (\(Anon u) y -> u <*> pure y :: f b) (\(Anon u) y -> pure ($ y) <*> u :: f b) ((,) <$> (Anon <$> genffa) <*> gena) shrinkNothing it ( unwords [ "satisfy the law about the functor instance: fmap f x = pure f <*> x for", genDescr @(a -> b) genfaname, "mapped over", genDescr @(f a) genname ] ) $ equivalentOnGens2 (\(Anon f) x -> fmap f x) (\(Anon f) x -> pure f <*> x) ((,) <$> (Anon <$> genfa) <*> gen) shrinkNothing describe (seqrTypeStr @f) $ it ( unwords [ "is equivalent to its default implementation 'u Type> v = pure (const id) <*> u <*> v' for", genDescr @(f a) genname, "in front of", genDescr @b genbname ] ) $ equivalentOnGens2 (\u v -> u *> v) (\u v -> pure (const id) <*> u <*> v) ((,) <$> gen <*> genb) shrinkNothing describe (seqlTypeStr @f) $ it ( unwords [ "is equivalent to its default implementation 'u <* v = pure const <*> u <*> v' for", genDescr @b genbname, "behind", genDescr @(f a) genname ] ) $ equivalentOnGens2 (\u v -> u <* v) (\u v -> pure const <*> u <*> v) ((,) <$> gen <*> genb) shrinkNothing genvalidity-hspec-1.0.0.3/src/Test/Validity/Arbitrary.hs0000644000000000000000000000221514507256377021264 0ustar0000000000000000{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} -- | Tests for Arbitrary instances involving Validity -- -- You will need @TypeApplications@ to use these. module Test.Validity.Arbitrary ( arbitrarySpec, arbitraryGeneratesOnlyValid, ) where import Data.Data import Data.GenValidity import Test.Hspec import Test.QuickCheck import Test.Validity.GenValidity import Test.Validity.Utils -- | A @Spec@ that specifies that @arbitrary@ only generates data that -- satisfy @isValid@ -- -- Example usage: -- -- > arbitrarySpec @Int arbitrarySpec :: forall a. (Typeable a, Show a, Validity a, Arbitrary a) => Spec arbitrarySpec = do let name = nameOf @a describe ("Arbitrary " ++ name) $ describe ("arbitrary :: Gen " ++ name) $ it "only generates valid values" $ arbitraryGeneratesOnlyValid @a -- | @arbitrary@ only generates valid data -- -- prop> arbitraryGeneratesOnlyValid @Int arbitraryGeneratesOnlyValid :: forall a. (Show a, Validity a, Arbitrary a) => Property arbitraryGeneratesOnlyValid = genGeneratesValid @a arbitrary genvalidity-hspec-1.0.0.3/src/Test/Validity/Eq.hs0000644000000000000000000000616014506460037017662 0ustar0000000000000000{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} -- | Eq properties -- -- You will need @TypeApplications@ to use these. module Test.Validity.Eq ( eqSpec, eqSpecOnArbitrary, eqSpecOnGen, ) where import Data.Data import Data.GenValidity import Test.Hspec import Test.QuickCheck import Test.Validity.Functions import Test.Validity.Relations import Test.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 genvalidity-hspec-1.0.0.3/src/Test/Validity/Functor.hs0000644000000000000000000001002114507256377020737 0ustar0000000000000000{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} -- | Functor properties -- -- You will need @TypeApplications@ to use these. module Test.Validity.Functor ( functorSpec, functorSpecOnArbitrary, functorSpecOnGens, ) where import Data.Data import Data.GenValidity import Data.Kind import Test.Hspec import Test.QuickCheck import Test.Validity.Functions import Test.Validity.Utils {-# ANN module "HLint: ignore Functor law" #-} fmapTypeStr :: forall (f :: Type -> Type). (Typeable f) => String fmapTypeStr = unwords [ "fmap", "::", "(a", "->", "b)", "->", nameOf @f, "a", "->", nameOf @f, "b" ] flTypeStr :: forall (f :: Type -> Type). (Typeable f) => String flTypeStr = unwords ["(<$)", "::", "a", "->", nameOf @f, "b", "->", nameOf @f, "a"] -- | Standard test spec for properties of Functor instances for values generated with GenValid instances -- -- Example usage: -- -- > functorSpecOnArbitrary @[] functorSpec :: forall (f :: Type -> Type). (Eq (f Int), Show (f Int), Functor f, Typeable f, GenValid (f Int)) => Spec functorSpec = functorSpecWithInts @f genValid -- | Standard test spec for properties of Functor instances for values generated with Arbitrary instances -- -- Example usage: -- -- > functorSpecOnArbitrary @[] functorSpecOnArbitrary :: forall (f :: Type -> Type). (Eq (f Int), Show (f Int), Functor f, Typeable f, Arbitrary (f Int)) => Spec functorSpecOnArbitrary = functorSpecWithInts @f arbitrary functorSpecWithInts :: forall (f :: Type -> Type). (Eq (f Int), Show (f Int), Functor f, Typeable f) => Gen (f Int) -> Spec functorSpecWithInts gen = functorSpecOnGens @f @Int genValid "int" gen (unwords [nameOf @f, "of ints"]) ((+) <$> genValid) "increments" ((*) <$> genValid) "scalings" -- | Standard test spec for properties of Functor instances for values generated by given generators (and names for those generator). -- -- Example usage: -- -- > functorSpecOnGens -- > @[] -- > @Int -- > (pure 4) "four" -- > (genListOf $ pure 5) "list of fives" -- > ((+) <$> genValid) "additions" -- > ((*) <$> genValid) "multiplications" functorSpecOnGens :: forall (f :: Type -> Type) (a :: Type) (b :: Type) (c :: Type). ( Show a, Show (f a), Show (f c), Eq (f a), Eq (f c), Functor f, Typeable f, Typeable a, Typeable b, Typeable c ) => Gen a -> String -> Gen (f a) -> String -> Gen (b -> c) -> String -> Gen (a -> b) -> String -> Spec functorSpecOnGens gena genaname gen genname genf genfname geng gengname = parallel $ describe ("Functor " ++ nameOf @f) $ do describe (fmapTypeStr @f) $ do it ( unwords [ "satisfies the first Fuctor law: 'fmap id == id' for", genDescr @(f a) genname ] ) $ equivalentOnGen (fmap @f id) (id @(f a)) gen shrinkNothing it ( unwords [ "satisfieds the second Functor law: 'fmap (f . g) == fmap f . fmap g' for", genDescr @(f a) genname, "'s", "given to", genDescr @(b -> c) genfname, "and", genDescr @(a -> b) gengname ] ) $ forAll (Anon <$> genf) $ \(Anon f) -> forAll (Anon <$> geng) $ \(Anon g) -> equivalentOnGen (fmap (f . g)) (fmap f . fmap g) gen shrinkNothing describe (flTypeStr @f) $ it ( unwords [ "is equivalent to its default implementation for", genDescr @a genaname, "and", genDescr @(f a) genname ] ) $ forAll gena $ \a -> equivalentOnGen (a <$) (fmap $ const a) gen shrinkNothing genvalidity-hspec-1.0.0.3/src/Test/Validity/GenValidity.hs0000644000000000000000000000316414506460037021535 0ustar0000000000000000{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} -- | Tests for GenValidity instances -- -- You will need @TypeApplications@ to use these. module Test.Validity.GenValidity ( genValidSpec, genValidGeneratesValid, genGeneratesValid, genGeneratesInvalid, ) where import Data.Data import Data.GenValidity import Test.Hspec import Test.QuickCheck import Test.Validity.GenValidity.Property import Test.Validity.Utils -- | A @Spec@ that specifies that @genValid@ only generates valid data. -- -- In general it is a good idea to add this spec to your test suite if you -- write a custom implementation of @genValid@. -- -- Example usage: -- -- > genValidSpec @Int genValidSpec :: forall a. (Typeable a, Show a, GenValid a) => Spec genValidSpec = parallel $ do let name = nameOf @a describe ("GenValid " ++ name) $ describe ("genValid :: Gen " ++ name) $ it ("only generates valid \'" ++ name ++ "\'s") $ genValidGeneratesValid @a -- | @genValid@ only generates valid data -- -- prop> genValidGeneratesValid @() -- prop> genValidGeneratesValid @Bool -- prop> genValidGeneratesValid @Ordering -- prop> genValidGeneratesValid @Char -- prop> genValidGeneratesValid @Int -- prop> genValidGeneratesValid @Float -- prop> genValidGeneratesValid @Double -- prop> genValidGeneratesValid @Integer -- prop> genValidGeneratesValid @(Maybe Int) -- prop> genValidGeneratesValid @[Int] genValidGeneratesValid :: forall a. (Show a, GenValid a) => Property genValidGeneratesValid = genGeneratesValid @a genValid genvalidity-hspec-1.0.0.3/src/Test/Validity/Monad.hs0000644000000000000000000001511414507256377020365 0ustar0000000000000000{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} -- | Monad properties -- -- You will need @TypeApplications@ to use these. module Test.Validity.Monad ( monadSpec, monadSpecOnArbitrary, monadSpecOnGens, ) where import Control.Monad (ap) import Data.Data import Data.GenValidity import Data.Kind (Type) import Test.Hspec import Test.QuickCheck import Test.QuickCheck.Gen (unGen) import Test.QuickCheck.Random (mkQCGen) import Test.Validity.Functions import Test.Validity.Utils {-# ANN module "HLint: ignore Use fmap" #-} {-# ANN module "HLint: ignore Use <$>" #-} {-# ANN module "HLint: ignore Use >=>" #-} {-# ANN module "HLint: ignore Use id" #-} {-# ANN module "HLint: ignore Monad law, left identity" #-} {-# ANN module "HLint: ignore Monad law, right identity" #-} {-# ANN module "HLint: ignore Avoid lambda" #-} {-# ANN module "HLint: ignore Reduce duplication" #-} returnTypeStr :: forall (m :: Type -> Type). (Typeable m) => String returnTypeStr = unwords ["return", "::", "a", "->", nameOf @m, "a"] bindTypeStr :: forall (m :: Type -> Type). (Typeable m) => String bindTypeStr = unwords [ "(>>=)", "::", nameOf @m, "a", "->", "(b", "->", nameOf @m, "a)", "->", nameOf @m, "b" ] -- | Standard test spec for properties of Monad instances for values generated with GenValid instances -- -- Example usage: -- -- > monadSpec @[] monadSpec :: forall (f :: Type -> Type). (Eq (f Int), Show (f Int), Monad f, Typeable f, GenValid (f Int)) => Spec monadSpec = monadSpecWithInts @f genValid -- | Standard test spec for properties of Monad instances for values generated with Arbitrary instances -- -- Example usage: -- -- > monadSpecOnArbitrary @[] monadSpecOnArbitrary :: forall (f :: Type -> Type). (Eq (f Int), Show (f Int), Monad f, Typeable f, Arbitrary (f Int)) => Spec monadSpecOnArbitrary = monadSpecWithInts @f arbitrary monadSpecWithInts :: forall (f :: Type -> Type). (Eq (f Int), Show (f Int), Monad f, Typeable f) => Gen (f Int) -> Spec monadSpecWithInts gen = monadSpecOnGens @f @Int genValid "int" gen (unwords [nameOf @f, "of ints"]) gen (unwords [nameOf @f, "of ints"]) ((+) <$> genValid) "increments" ( do s <- genListLength pure $ \b -> unGen gen (mkQCGen b) s ) "perturbations using the int" ( do s <- genListLength pure $ \b -> unGen gen (mkQCGen $ 2 * b) s ) "perturbations using the double the int" (pure <$> ((+) <$> genValid)) (unwords [nameOf @f, "of additions"]) -- | Standard test spec for properties of Monad instances for values generated by given generators (and names for those generator). -- -- Example usage: -- -- > monadSpecOnGens -- > @[] -- > @Int -- > (pure 4) -- > "four" -- > (genListOf $ pure 5) -- > "list of fives" -- > (genListOf $ pure 6) -- > "list of sixes" -- > ((*) <$> genValid) -- > "factorisations" -- > (pure $ \a -> [a]) -- > "singletonisation" -- > (pure $ \a -> [a]) -- > "singletonisation" -- > (pure $ pure (+ 1)) -- > "increment in list" monadSpecOnGens :: forall (f :: Type -> Type) (a :: Type) (b :: Type) (c :: Type). ( Show a, Show (f a), Show (f b), Show (f c), Eq (f a), Eq (f b), Eq (f c), Monad f, Typeable f, Typeable a, Typeable b, Typeable c ) => Gen a -> String -> Gen (f a) -> String -> Gen (f b) -> String -> Gen (a -> b) -> String -> Gen (a -> f b) -> String -> Gen (b -> f c) -> String -> Gen (f (a -> b)) -> String -> Spec monadSpecOnGens gena genaname gen genname genb genbname geng gengname genbf genbfname gencf gencfname genfab genfabname = parallel $ describe ("Monad " ++ nameOf @f) $ do describe (unwords [returnTypeStr @f, "and", bindTypeStr @f]) $ do it ( unwords [ "satisfy the first Monad law: 'return a >>= k = k a' for", genDescr @a genaname, "and", genDescr @(a -> f b) genbfname ] ) $ equivalentOnGens2 (\a (Anon k) -> return a >>= k) (\a (Anon k) -> k a) ((,) <$> gena <*> (Anon <$> genbf)) shrinkNothing it ( unwords [ "satisfy the second Monad law: 'm >>= return = m' for", genDescr @(f a) genname ] ) $ equivalentOnGen (\m -> m >>= return) (\m -> m) gen shrinkNothing describe (bindTypeStr @f) $ it ( unwords [ "satisfies the third Monad law: 'm >>= (x -> k x >>= h) = (m >>= k) >>= h' for", genDescr @(f a) genname, genDescr @(a -> f b) genbfname, "and", genDescr @(b -> f c) gencfname ] ) $ equivalentOnGens3 (\m (Anon k) (Anon h) -> m >>= (\x -> k x >>= h)) (\m (Anon k) (Anon h) -> (m >>= k) >>= h) ((,,) <$> gen <*> (Anon <$> genbf) <*> (Anon <$> gencf)) shrinkNothing describe (unwords ["relation with Applicative", nameOf @f]) $ do it ( unwords ["satisfies 'pure = return' for", genDescr @(f a) genname] ) $ equivalentOnGen (pure @f) (return @f) gena shrinkNothing it ( unwords [ "satisfies '(<*>) = ap' for", genDescr @(f (a -> b)) genfabname, "and", genDescr @(f a) genname ] ) $ equivalentOnGens2 (\(Anon a) b -> a <*> b) (\(Anon a) b -> ap a b) ((,) <$> (Anon <$> genfab) <*> gen) shrinkNothing it ( unwords [ "satisfies '(>>) = (*>)' for", genDescr @(f a) genname, "and", genDescr @(f b) genbname ] ) $ equivalentOnGens2 (>>) (*>) ((,) <$> gen <*> genb) shrinkNothing describe (unwords ["relation with Functor", nameOf @f]) $ it ( unwords [ "satisfies 'fmap f xs = xs >>= return . f' for", genDescr @(a -> b) gengname, "and", genDescr @(f a) genname ] ) $ equivalentOnGens2 (\(Anon f) xs -> fmap f xs) (\(Anon f) xs -> xs >>= (return . f)) ((,) <$> (Anon <$> geng) <*> gen) shrinkNothing genvalidity-hspec-1.0.0.3/src/Test/Validity/Monoid.hs0000644000000000000000000000640214507256377020554 0ustar0000000000000000{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} -- | Monoid properties -- -- You will need @TypeApplications@ to use these. module Test.Validity.Monoid ( monoidSpecOnValid, monoidSpec, monoidSpecOnArbitrary, monoidSpecOnGen, ) where import Data.Data import Data.GenValidity import Test.Hspec import Test.QuickCheck import Test.Validity.Functions import Test.Validity.Operations import Test.Validity.Utils memptyTypeStr :: forall a. Typeable a => String memptyTypeStr = unwords ["mempty", "::", nameOf @a] mappendTypeStr :: forall a. Typeable a => String mappendTypeStr = unwords ["mappend", "::", an, "->", an, "->", an] where an = nameOf @a mconcatTypeStr :: forall a. Typeable a => String mconcatTypeStr = unwords ["mconcat", "::", "[" ++ an ++ "]", "->", an] where an = nameOf @a -- | Standard test spec for properties of 'Monoid' instances for valid values -- -- Example usage: -- -- > monoidSpecOnValid @[Double] monoidSpecOnValid :: forall a. (Show a, Eq a, Monoid a, Typeable a, GenValid a) => Spec monoidSpecOnValid = monoidSpecOnGen @a genValid "valid" shrinkValid -- | Standard test spec for properties of 'Monoid' instances for valid values -- -- Example usage: -- -- > monoidSpec @[Int] monoidSpec :: forall a. (Show a, Eq a, Monoid a, Typeable a, GenValid a) => Spec monoidSpec = monoidSpecOnGen @a genValid "valid" shrinkValid -- | Standard test spec for properties of 'Monoid' instances for arbitrary values -- -- Example usage: -- -- > monoidSpecOnArbitrary @[Int] monoidSpecOnArbitrary :: forall a. (Show a, Eq a, Monoid a, Typeable a, Arbitrary a) => Spec monoidSpecOnArbitrary = monoidSpecOnGen @a arbitrary "arbitrary" shrink -- | Standard test spec for properties of Monoid instances for values generated by a given generator (and name for that generator). -- -- Example usage: -- -- > monoidSpecOnGen (pure "a") "singleton list of 'a'" monoidSpecOnGen :: forall a. (Show a, Eq a, Monoid a, Typeable a) => Gen a -> String -> (a -> [a]) -> Spec monoidSpecOnGen gen genname s = parallel $ do let name = nameOf @a memptystr = memptyTypeStr @a mappendstr = mappendTypeStr @a mconcatstr = mconcatTypeStr @a gen3 = (,,) <$> gen <*> gen <*> gen s3 (a, b, c) = (,,) <$> s a <*> s b <*> s c genl = genListOf gen sl = shrinkList s describe ("Monoid " ++ name) $ do let mem = mempty @a mapp = mappend @a mcon = mconcat @a describe memptystr $ it ( unwords [ "is the identity for", mappendstr, "for", genDescr @a genname ] ) $ identityOnGen mapp mem gen s describe mappendstr $ it ( unwords [ "is an associative operation for", genDescr @(a, a, a) genname ] ) $ associativeOnGens mapp gen3 s3 describe mconcatstr $ it ( unwords [ "is equivalent to its default implementation for", genDescr @[a] genname ] ) $ equivalentOnGen mcon (foldr mapp mem) genl sl genvalidity-hspec-1.0.0.3/src/Test/Validity/Ord.hs0000644000000000000000000001031114506460037020032 0ustar0000000000000000{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} -- | Ord properties -- -- You will need @TypeApplications@ to use these. module Test.Validity.Ord ( ordSpec, ordSpecOnGen, ordSpecOnArbitrary, ) where import Data.Data import Data.GenValidity import Test.Hspec import Test.QuickCheck import Test.Validity.Functions import Test.Validity.Relations import Test.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 genvalidity-hspec-1.0.0.3/src/Test/Validity/Show.hs0000644000000000000000000000444614506460037020242 0ustar0000000000000000{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} -- | 'Show' and 'Read' properties module Test.Validity.Show ( showReadSpec, showReadSpecOnArbitrary, showReadSpecOnGen, showReadRoundTrip, showReadRoundTripOnArbitrary, showReadRoundTripOnGen, ) where import Data.Data import Data.GenValidity import Test.Hspec import Test.QuickCheck import Test.Validity.Utils import Text.Read -- | Standard test spec for properties of Show and Read instances for valid values -- -- Example usage: -- -- > showReadSpec @Int showReadSpec :: forall a. (Show a, Eq a, Read a, Typeable a, GenValid a) => Spec showReadSpec = showReadSpecOnGen @a genValid "valid" shrinkValid -- | Standard test spec for properties of Show and Read instances for arbitrary values -- -- Example usage: -- -- > showReadSpecOnArbitrary @Double showReadSpecOnArbitrary :: forall a. (Show a, Eq a, Read a, Typeable a, Arbitrary a) => Spec showReadSpecOnArbitrary = showReadSpecOnGen @a arbitrary "arbitrary" shrink -- | Standard test spec for properties of Show and Read instances for values generated by a custom generator -- -- Example usage: -- -- > showReadSpecOnGen ((* 2) <$> genValid @Int) "even" (const []) showReadSpecOnGen :: forall a. (Show a, Eq a, Read a, Typeable a) => Gen a -> String -> (a -> [a]) -> Spec showReadSpecOnGen gen n s = describe (unwords ["Show", nameOf @a, "and Read", nameOf @a]) $ it (unwords ["are implemented such that read . show == id for", n, "values"]) $ showReadRoundTripOnGen gen s -- | -- -- prop> showReadRoundTrip @Int showReadRoundTrip :: forall a. (Show a, Eq a, Read a, GenValid a) => Property showReadRoundTrip = showReadRoundTripOnGen (genValid :: Gen a) shrinkValid -- | -- -- prop> showReadRoundTripOnArbitrary @Double showReadRoundTripOnArbitrary :: forall a. (Show a, Eq a, Read a, Arbitrary a) => Property showReadRoundTripOnArbitrary = showReadRoundTripOnGen (arbitrary :: Gen a) shrink -- | -- -- prop> showReadRoundTripOnGen (abs <$> genValid :: Gen Int) (const []) showReadRoundTripOnGen :: (Show a, Eq a, Read a) => Gen a -> (a -> [a]) -> Property showReadRoundTripOnGen gen s = forAllShrink gen s $ \v -> readMaybe (show v) `shouldBe` Just v genvalidity-hspec-1.0.0.3/src/Test/Validity/Shrinking.hs0000644000000000000000000000466514507256377021274 0ustar0000000000000000{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} -- | Tests for Shrinking functions -- -- You will need @TypeApplications@ to use these. module Test.Validity.Shrinking ( shrinkValidSpec, shrinkValidSpecWithLimit, shrinkValidPreservesValidOnGenValid, shrinkValidPreservesValidOnGenValidWithLimit, shrinkPreservesValidOnGenValid, shrinkValidPreservesValid, shrinkingStaysValid, shrinkingPreserves, shrinkValidDoesNotShrinkToItself, shrinkValidDoesNotShrinkToItselfWithLimit, ) where import Control.Monad import Data.Data import Data.GenValidity import Test.Hspec import Test.QuickCheck import Test.Validity.Shrinking.Property import Test.Validity.Utils shrinkValidSpec :: forall a. (Show a, Eq a, Typeable a, GenValid a) => Spec shrinkValidSpec = describe ("shrinkValid :: " ++ nameOf @(a -> [a])) $ do it "preserves validity" $ forAll (genValid @a) $ \a -> forM_ (shrinkValid a) shouldBeValid it "never shrinks to itself for valid values" $ shrinkValidDoesNotShrinkToItself @a shrinkValidSpecWithLimit :: forall a. (Show a, Eq a, Typeable a, GenValid a) => Int -> Spec shrinkValidSpecWithLimit l = describe ("shrinkValid :: " ++ nameOf @(a -> [a])) $ do it (unwords ["preserves validity for the first", show l, "elements"]) $ forAll (genValid @a) $ \a -> forM_ (take l $ shrinkValid a) shouldBeValid it ( unwords [ "never shrinks to itself for valid values for the first", show l, "elements" ] ) $ shrinkValidDoesNotShrinkToItselfWithLimit @a l shrinkValidPreservesValidOnGenValid :: forall a. (Show a, GenValid a) => Property shrinkValidPreservesValidOnGenValid = shrinkingStaysValid @a genValid shrinkValid shrinkValidPreservesValidOnGenValidWithLimit :: forall a. (Show a, GenValid a) => Int -> Property shrinkValidPreservesValidOnGenValidWithLimit = shrinkingStaysValidWithLimit @a genValid shrinkValid shrinkValidDoesNotShrinkToItself :: forall a. (Show a, Eq a, GenValid a) => Property shrinkValidDoesNotShrinkToItself = shrinkDoesNotShrinkToItself @a shrinkValid shrinkValidDoesNotShrinkToItselfWithLimit :: forall a. (Show a, Eq a, GenValid a) => Int -> Property shrinkValidDoesNotShrinkToItselfWithLimit = shrinkDoesNotShrinkToItselfOnValidWithLimit @a shrinkValid genvalidity-hspec-1.0.0.3/src/Test/Validity/Utils.hs0000644000000000000000000000617114507256377020432 0ustar0000000000000000{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE CPP #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -Wno-deprecations #-} -- | Utilities for defining your own validity 'Spec's -- -- You will need @TypeApplications@ to use these. module Test.Validity.Utils ( nameOf, genDescr, binRelStr, shouldFail, failsBecause, Anon (..), shouldBeValid, shouldBeInvalid, ) where import Control.Arrow (second) import Control.Monad.Trans.Writer (mapWriterT) import Data.Data import Test.Hspec import Test.Hspec.Core.Formatters import Test.Hspec.Core.Runner import Test.Hspec.Core.Spec import Test.QuickCheck.Property import Test.Validity.Property.Utils nameOf :: forall a. Typeable a => String nameOf = let s = show $ typeRep (Proxy @a) in if ' ' `elem` s then "(" ++ s ++ ")" else s genDescr :: forall a. Typeable a => String -> String genDescr genname = unwords ["\"" ++ genname, "::", nameOf @a ++ "\""] binRelStr :: forall a. Typeable a => String -> String binRelStr op = unwords ["(" ++ op ++ ")", "::", name, "->", name, "->", "Bool"] where name = nameOf @a newtype Anon a = Anon a instance Show (Anon a) where show _ = "Anonymous" instance Functor Anon where fmap f (Anon a) = Anon (f a) -- I'm not sure why mapSpecTree was removed from hspec-core, -- but it has been copied here for convenience. -- https://github.com/hspec/hspec/commit/020c7ecc4a73c24af38e9fab049f60bb9aec6981#diff-29cb22f0ef6e98086a71fc045847bd21L22 mapSpecTree' :: (SpecTree a -> SpecTree b) -> SpecM a r -> SpecM b r #if MIN_VERSION_hspec(2,10,0) mapSpecTree' f (SpecM specs) = SpecM (mapWriterT (fmap (second (fmap (map f)))) specs) #else mapSpecTree' f (SpecM specs) = SpecM (mapWriterT (fmap (second (map f))) specs) #endif -- | Asserts that a given 'Spec' tree fails _somewhere_. -- -- It also shows the given string when reporting that the tree unexpectedly -- succeeded. failsBecause :: String -> SpecWith () -> SpecWith () failsBecause s = mapSpecTree' go where go :: SpecTree () -> SpecTree () go sp = Leaf Item { itemRequirement = s, itemLocation = Nothing, itemIsFocused = False, itemIsParallelizable = Nothing, itemExample = \_ _ _ -> do let conf = defaultConfig {configFormatter = Just silent} r <- hspecWithResult conf $ fromSpecList [sp] let succesful = summaryExamples r > 0 && summaryFailures r > 0 pure $ produceResult succesful } produceResult :: Bool -> Test.Hspec.Core.Spec.Result produceResult succesful = Result { resultInfo = "", resultStatus = if succesful then Success else Failure Nothing $ Test.Hspec.Core.Spec.Reason "Should have failed but didn't." } shouldFail :: Property -> Property shouldFail = mapResult $ \res -> res { reason = unwords ["Should have failed:", reason res], expect = not $ expect res } genvalidity-hspec-1.0.0.3/test/Spec.hs0000644000000000000000000000005414506460037015667 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} genvalidity-hspec-1.0.0.3/test/Test/Validity/ApplicativeSpec.hs0000644000000000000000000000167314506460037022565 0ustar0000000000000000{-# LANGUAGE TypeApplications #-} module Test.Validity.ApplicativeSpec where import Data.GenValidity import Test.Hspec import Test.Validity.Applicative spec :: Spec spec = do applicativeSpec @(Either Int) applicativeSpec @[] applicativeSpec @Maybe applicativeSpecOnArbitrary @[] applicativeSpecOnArbitrary @Maybe applicativeSpecOnGens @[] @Int (pure 4) "four" (genListOf $ pure 5) "list of fives" (pure []) "purely empty list" ((+) <$> genValid) "increments" (pure <$> ((+) <$> genValid)) "increments in a list" (pure <$> ((*) <$> genValid)) "scalings in a list" applicativeSpecOnGens @Maybe @String (pure "ABC") "ABC" (Just <$> pure "ABC") "Just an ABC" (pure Nothing) "purely Nothing" ((++) <$> genValid) "prepends" (pure <$> ((++) <$> genValid)) "prepends in a Just" (pure <$> (flip (++) <$> genValid)) "appends in a Just" genvalidity-hspec-1.0.0.3/test/Test/Validity/ArbitrarySpec.hs0000644000000000000000000000024614506460037022256 0ustar0000000000000000{-# LANGUAGE TypeApplications #-} module Test.Validity.ArbitrarySpec where import Test.Hspec import Test.Validity.Arbitrary spec :: Spec spec = arbitrarySpec @Int genvalidity-hspec-1.0.0.3/test/Test/Validity/EqSpec.hs0000644000000000000000000000141614506460037020664 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TypeApplications #-} module Test.Validity.EqSpec where import Data.GenValidity import GHC.Generics (Generic) import Test.Hspec import Test.Validity.Eq import Test.Validity.Utils spec :: Spec spec = do eqSpec @Rational eqSpec @Int -- eqSpec @Double DOES NOT HOLD because of NaN eqSpecOnArbitrary @Int eqSpecOnGen ((* 2) <$> genValid @Int) "even" (const []) failsBecause "(/=) and (==) don't have opposite semantics" $ eqSpec @EqFuncMismatch newtype EqFuncMismatch = EqFuncMismatch () deriving (Show, Generic) instance Validity EqFuncMismatch instance Eq EqFuncMismatch where (==) _ _ = True (/=) _ _ = True instance GenValid EqFuncMismatch where genValid = EqFuncMismatch <$> genValid shrinkValid _ = [] genvalidity-hspec-1.0.0.3/test/Test/Validity/FunctorSpec.hs0000644000000000000000000000215214506460037021735 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TypeApplications #-} module Test.Validity.FunctorSpec where import Data.GenValidity import GHC.Generics (Generic) import Test.Hspec import Test.Validity.Functor import Test.Validity.Utils spec :: Spec spec = do functorSpec @[] functorSpec @Maybe failsBecause "Fcks does not satisfy any Functor laws" $ functorSpec @Fcks functorSpec @(Either Int) functorSpec @((,) Int) functorSpecOnArbitrary @[] functorSpecOnArbitrary @Maybe functorSpecOnGens @[] @Int (pure 4) "four" (genListOf $ pure 5) "list of fives" ((+) <$> genValid) "increments" ((*) <$> genValid) "scalings" functorSpecOnGens @Maybe @String (pure "ABC") "ABC" (Just <$> pure "ABC") "Just an ABC" ((++) <$> genValid) "prepends" (flip (++) <$> genValid) "appends" newtype Fcks a = Fcks Int deriving (Show, Eq, Generic) instance Validity (Fcks a) instance GenValid (Fcks a) where genValid = Fcks <$> genValid shrinkValid (Fcks i) = Fcks <$> shrinkValid i instance Functor Fcks where fmap _ (Fcks i) = Fcks $ i * 2 genvalidity-hspec-1.0.0.3/test/Test/Validity/GenRelativeValiditySpec.hs0000644000000000000000000000030014506460037024221 0ustar0000000000000000module Test.Validity.GenRelativeValiditySpec where import Test.Hspec -- import Test.Validity.GenRelativeValidity spec :: Spec spec = pure () -- TODO add examples once we have some instances genvalidity-hspec-1.0.0.3/test/Test/Validity/GenValiditySpec.hs0000644000000000000000000000031414506460037022532 0ustar0000000000000000{-# LANGUAGE TypeApplications #-} module Test.Validity.GenValiditySpec where import Test.Hspec import Test.Validity.GenValidity spec :: Spec spec = do genValidSpec @Rational genValidSpec @Rational genvalidity-hspec-1.0.0.3/test/Test/Validity/MonadSpec.hs0000644000000000000000000000174614506460037021363 0ustar0000000000000000{-# LANGUAGE TypeApplications #-} module Test.Validity.MonadSpec where import Data.GenValidity import Test.Hspec import Test.Validity.Monad {-# ANN module "HLint: ignore Use :" #-} spec :: Spec spec = do monadSpec @[] monadSpec @Maybe monadSpec @(Either Int) monadSpecOnArbitrary @[] monadSpecOnArbitrary @Maybe monadSpecOnGens @[] @Int (pure 4) "four" (genListOf $ pure 5) "list of fives" (genListOf $ pure 6) "list of sixes" ((*) <$> genValid) "factorisations" (pure $ \a -> [a]) "singletonisation" (pure $ \a -> [a]) "singletonisation" (pure $ pure (+ 1)) "increment in list" monadSpecOnGens @Maybe @String (pure "ABC") "ABC" (Just <$> pure "ABC") "Just an ABC" (Just <$> pure "CDE") "Just an ABC" (flip (++) <$> genValid) "appends" (pure $ \a -> Just a) "justisation" (pure $ \a -> Just a) "justisation" (pure $ pure (++ "a")) "append 'a' in Just" genvalidity-hspec-1.0.0.3/test/Test/Validity/MonoidSpec.hs0000644000000000000000000000044314506460037021543 0ustar0000000000000000{-# LANGUAGE TypeApplications #-} module Test.Validity.MonoidSpec where import Test.Hspec import Test.Validity.Monoid spec :: Spec spec = do monoidSpecOnValid @[Rational] monoidSpec @[Int] monoidSpecOnArbitrary @[Int] monoidSpecOnGen (pure "a") "singleton list of 'a'" (const []) genvalidity-hspec-1.0.0.3/test/Test/Validity/OrdSpec.hs0000644000000000000000000000055414506460037021045 0ustar0000000000000000{-# LANGUAGE TypeApplications #-} module Test.Validity.OrdSpec where import Data.GenValidity import Test.Hspec import Test.Validity.Ord import Test.Validity.Utils spec :: Spec spec = do ordSpec @Rational failsBecause "NaN >= NaN is False" $ ordSpec @Double ordSpec @Int ordSpecOnArbitrary @Int ordSpecOnGen ((* 2) <$> genValid @Int) "even" (const []) genvalidity-hspec-1.0.0.3/test/Test/Validity/RelativeValiditySpec.hs0000644000000000000000000000021114506460037023570 0ustar0000000000000000module Test.Validity.RelativeValiditySpec where import Test.Hspec -- import Test.Validity.RelativeValidity spec :: Spec spec = pure () genvalidity-hspec-1.0.0.3/test/Test/Validity/ShowSpec.hs0000644000000000000000000000141314506460037021234 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TypeApplications #-} module Test.Validity.ShowSpec where import Data.GenValidity import GHC.Generics (Generic) import Test.Hspec import Test.Validity.Show import Test.Validity.Utils spec :: Spec spec = do showReadSpec @Rational showReadSpec @Int showReadSpecOnArbitrary @Rational showReadSpecOnGen ((* 2) <$> genValid @Int) "even" (const []) failsBecause "show and read don't have the correct semantics" $ showReadSpec @ShowFuncMismatch data ShowFuncMismatch = ShowFuncMismatch deriving (Eq, Read, Generic) instance Validity ShowFuncMismatch instance Show ShowFuncMismatch where show ShowFuncMismatch = "wrong" instance GenValid ShowFuncMismatch where genValid = pure ShowFuncMismatch shrinkValid _ = [] genvalidity-hspec-1.0.0.3/test/Test/Validity/ShrinkingSpec.hs0000644000000000000000000000170114506460037022250 0ustar0000000000000000{-# LANGUAGE TypeApplications #-} module Test.Validity.ShrinkingSpec where import Data.Int import Data.Ratio import Test.Hspec import Test.Validity.Shrinking spec :: Spec spec = do shrinkValidSpec @(Ratio Int8) shrinkValidSpec @Int describe "shrinkValidPreservesValidOnGenValid" $ do it "Ordering" $ shrinkValidPreservesValidOnGenValid @Ordering it "[Ordering]" $ shrinkValidPreservesValidOnGenValid @[Ordering] describe "shrinkValidPreservesValidOnGenValid" $ do it "Ordering" $ shrinkValidPreservesValidOnGenValid @Ordering it "[Ordering]" $ shrinkValidPreservesValidOnGenValid @[Ordering] describe "shrinkValidDoesNotShrinkToItself" $ do it "Int" $ shrinkValidDoesNotShrinkToItself @Int it "[Int]" $ shrinkValidDoesNotShrinkToItself @[Int] describe "shrinkValidDoesNotShrinkToItself" $ do it "Ordering" $ shrinkValidDoesNotShrinkToItself @Ordering it "[Ordering]" $ shrinkValidDoesNotShrinkToItself @[Ordering] genvalidity-hspec-1.0.0.3/LICENSE0000644000000000000000000000210414506460037014465 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-hspec-1.0.0.3/CHANGELOG.md0000644000000000000000000000254114507256377015311 0ustar0000000000000000# Changelog ## [1.0.0.3] - 2022-10-04 ### Changed * Compatibility with `hspec-core >= 2.11`. ## [1.0.0.2] - 2022-09-20 Same as 1.0.0.1, but with the right commit. ## [1.0.0.1] - 2022-09-02 ### Changed * Compatibility with `hspec-core >= 2.10` ## [1.0.0.0] - 2021-11-20 ### Changed * Compatibility with `validity >= 0.12.0.0` * 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. * Everything related to `RelativeValidity`. ## [0.7.0.3] - 2020-02-10 ### Changed * Removed doctests * Improved the cabal file * Fixed the `monadSpec` to not generate the list length using `genUnchecked` ## [0.7.0.2] - 2019-09-23 * Removed nonsense shrinking from `genValidSpec` and `genInvalidSpec`. ## [0.7.0.1] - 2019-09-23 * Removed nonsense shrinking from `arbitraryGeneratesOnlyValid`, `genValidGeneratesValid` and `genInvalidGeneratesInvalid`. ## [0.7.0.0] - 2019-03-06 ### Changed * Fixed compatibility with genvalidity >=0.8 ## [0.6.2.3] - 2019-02-28 ### Changed * Clearer docs ## [0.6.2.2] - 2019-01-09 ### Changed * Fixed a forward incompatibility with hspec 2.6.x. ## [0.3.0.1] - 2018-10-07 ### Changed * Compatibility with validity >=0.9, genvalidity >=0.7 and genvalidity-property >=0.3 genvalidity-hspec-1.0.0.3/genvalidity-hspec.cabal0000644000000000000000000000534314507257017020076 0ustar0000000000000000cabal-version: 1.12 -- This file has been generated from package.yaml by hpack version 0.35.2. -- -- see: https://github.com/sol/hpack name: genvalidity-hspec version: 1.0.0.3 synopsis: Standard spec's for GenValidity instances description: Note: There are companion packages for this library: . * . * . * . * 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 Test.Validity.Applicative Test.Validity.Arbitrary Test.Validity.Eq Test.Validity.Functor Test.Validity.GenValidity Test.Validity.Monad Test.Validity.Monoid Test.Validity.Ord Test.Validity.Show Test.Validity.Shrinking Test.Validity.Utils other-modules: Paths_genvalidity_hspec hs-source-dirs: src ghc-options: -Wall -fwarn-redundant-constraints build-depends: QuickCheck , base >=4.9 && <5 , genvalidity >=1.0 , genvalidity-property >=0.5 , hspec , hspec-core >=2.5.0 , transformers , validity >=0.5 default-language: Haskell2010 test-suite genvalidity-hspec-test type: exitcode-stdio-1.0 main-is: Spec.hs other-modules: Test.Validity.ApplicativeSpec Test.Validity.ArbitrarySpec Test.Validity.EqSpec Test.Validity.FunctorSpec Test.Validity.GenRelativeValiditySpec Test.Validity.GenValiditySpec Test.Validity.MonadSpec Test.Validity.MonoidSpec Test.Validity.OrdSpec Test.Validity.RelativeValiditySpec Test.Validity.ShowSpec Test.Validity.ShrinkingSpec Paths_genvalidity_hspec hs-source-dirs: test/ ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall build-depends: QuickCheck , base >=4.9 && <5 , genvalidity , genvalidity-hspec , hspec , hspec-core >=2.5.0 default-language: Haskell2010