genvalidity-hspec-0.7.0.4/src/0000755000000000000000000000000013612602711014253 5ustar0000000000000000genvalidity-hspec-0.7.0.4/src/Test/0000755000000000000000000000000013612602711015172 5ustar0000000000000000genvalidity-hspec-0.7.0.4/src/Test/Validity/0000755000000000000000000000000013620324650016761 5ustar0000000000000000genvalidity-hspec-0.7.0.4/test/0000755000000000000000000000000013612602711014443 5ustar0000000000000000genvalidity-hspec-0.7.0.4/test/Test/0000755000000000000000000000000013612602711015362 5ustar0000000000000000genvalidity-hspec-0.7.0.4/test/Test/Validity/0000755000000000000000000000000013620324062017146 5ustar0000000000000000genvalidity-hspec-0.7.0.4/src/Test/Validity.hs0000644000000000000000000002022313612602711017312 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' -- * 'eqSpecOnValid' -- * 'ordSpecOnValid' -- * 'producesValidsOnValids' -- * 'forAllValid' -- * 'shouldBeValid' module Test.Validity ( -- * Writing properties -- ** Cheap generation with shrinking forAllUnchecked , forAllValid , forAllInvalid -- ** Cheap assertions , shouldBeValid , shouldBeInvalid -- * Tests for GenValidity instances , genValiditySpec , genValidSpec , genInvalidSpec , genValidGeneratesValid , genGeneratesValid , genInvalidGeneratesInvalid , genGeneratesInvalid , shrinkValiditySpec , shrinkValidSpec , shrinkValidSpecWithLimit , shrinkInvalidSpec , shrinkValidPreservesValidOnGenValid , shrinkInvalidPreservesInvalidOnGenInvalid , shrinkPreservesValidOnGenValid , shrinkPreservesInvalidOnGenInvalid , shrinkValidPreservesValid , shrinkInvalidPreservesInvalid , shrinkingStaysValid , shrinkingStaysInvalid , shrinkingPreserves -- * Tests for Arbitrary instances involving Validity , arbitrarySpec , arbitraryGeneratesOnlyValid -- * Tests for RelativeValidity instances , relativeValiditySpec , relativeValidityImpliesValidA , relativeValidityImpliesValidB -- * Tests for GenRelativeValidity instances , genRelativeValiditySpec , genRelativeValidGeneratesValid , genRelativeInvalidGeneratesInvalid -- * Standard tests involving functions -- ** Standard tests involving validity , producesValidsOnGen , producesValidsOnValids , producesValid , producesValidsOnArbitrary , producesValidsOnGens2 , producesValidsOnValids2 , producesValid2 , producesValidsOnArbitrary2 , producesValidsOnGens3 , producesValidsOnValids3 , producesValid3 , producesValidsOnArbitrary3 -- ** Standard tests involving functions that can fail , CanFail(..) , succeedsOnGen , succeedsOnValid , succeeds , succeedsOnArbitrary , succeedsOnGens2 , succeedsOnValids2 , succeeds2 , succeedsOnArbitrary2 , failsOnGen , failsOnInvalid , failsOnGens2 , failsOnInvalid2 , validIfSucceedsOnGen , validIfSucceedsOnValid , validIfSucceedsOnArbitrary , validIfSucceeds , validIfSucceedsOnGens2 , validIfSucceedsOnValids2 , validIfSucceeds2 , validIfSucceedsOnArbitrary2 , validIfSucceedsOnGens3 , validIfSucceedsOnValids3 , validIfSucceeds3 , validIfSucceedsOnArbitrary3 -- ** Standard tests involving equivalence of functions -- *** Simple functions -- **** One argument , equivalentOnGen , equivalentOnValid , equivalent , equivalentOnArbitrary -- **** Two arguments , equivalentOnGens2 , equivalentOnValids2 , equivalent2 , equivalentOnArbitrary2 -- **** Three arguments , equivalentOnGens3 , equivalentOnValids3 , equivalent3 , equivalentOnArbitrary3 -- *** First function can fail -- **** One argument , equivalentWhenFirstSucceedsOnGen , equivalentWhenFirstSucceedsOnValid , equivalentWhenFirstSucceeds , equivalentWhenFirstSucceedsOnArbitrary -- **** Two arguments , equivalentWhenFirstSucceedsOnGens2 , equivalentWhenFirstSucceedsOnValids2 , equivalentWhenFirstSucceeds2 , equivalentWhenFirstSucceedsOnArbitrary2 -- *** Second function can fail -- **** One argument , equivalentWhenSecondSucceedsOnGen , equivalentWhenSecondSucceedsOnValid , equivalentWhenSecondSucceeds , equivalentWhenSecondSucceedsOnArbitrary -- **** Two arguments , equivalentWhenSecondSucceedsOnGens2 , equivalentWhenSecondSucceedsOnValids2 , equivalentWhenSecondSucceeds2 , equivalentWhenSecondSucceedsOnArbitrary2 -- *** Both functions can fail -- **** One argument , equivalentWhenSucceedOnGen , equivalentWhenSucceedOnValid , equivalentWhenSucceed , equivalentWhenSucceedOnArbitrary -- **** Two arguments , equivalentWhenSucceedOnGens2 , equivalentWhenSucceedOnValids2 , equivalentWhenSucceed2 , equivalentWhenSucceedOnArbitrary2 -- ** Standard tests involving inverse functions , inverseFunctionsOnGen , inverseFunctionsOnValid , inverseFunctions , inverseFunctionsOnArbitrary , inverseFunctionsIfFirstSucceedsOnGen , inverseFunctionsIfFirstSucceedsOnValid , inverseFunctionsIfFirstSucceeds , inverseFunctionsIfFirstSucceedsOnArbitrary , inverseFunctionsIfSecondSucceedsOnGen , inverseFunctionsIfSecondSucceedsOnValid , inverseFunctionsIfSecondSucceeds , inverseFunctionsIfSecondSucceedsOnArbitrary , inverseFunctionsIfSucceedOnGen , inverseFunctionsIfSucceedOnValid , inverseFunctionsIfSucceed , inverseFunctionsIfSucceedOnArbitrary -- ** Properties involving idempotence , idempotentOnGen , idempotentOnValid , idempotent , idempotentOnArbitrary -- * Properties of relations -- ** Reflexivity , reflexiveOnElem , reflexivityOnGen , reflexivityOnValid , reflexivity , reflexivityOnArbitrary -- ** Transitivity , transitiveOnElems , transitivityOnGens , transitivityOnValid , transitivity , transitivityOnArbitrary -- ** Antisymmetry , antisymmetricOnElemsWithEquality , antisymmetryOnGensWithEquality , antisymmetryOnGens , antisymmetryOnValid , antisymmetry , antisymmetryOnArbitrary -- ** Antireflexivity , antireflexiveOnElem , antireflexivityOnGen , antireflexivityOnValid , antireflexivity , antireflexivityOnArbitrary -- ** Symmetry , symmetricOnElems , symmetryOnGens , symmetryOnValid , symmetry , symmetryOnArbitrary -- * Properties of operations -- ** Identity element -- *** Left Identity , leftIdentityOnElemWithEquality , leftIdentityOnGenWithEquality , leftIdentityOnGen , leftIdentityOnValid , leftIdentity , leftIdentityOnArbitrary -- *** Right Identity , rightIdentityOnElemWithEquality , rightIdentityOnGenWithEquality , rightIdentityOnGen , rightIdentityOnValid , rightIdentity , rightIdentityOnArbitrary -- *** Identity , identityOnGen , identityOnValid , identity , identityOnArbitrary -- ** Associativity , associativeOnGens , associativeOnValids , associative , associativeOnArbitrary -- ** Commutativity , commutativeOnGens , commutativeOnValids , commutative , commutativeOnArbitrary -- * Show and Read properties , showReadSpecOnValid , showReadSpec , showReadSpecOnArbitrary , showReadSpecOnGen -- * Eq properties , eqSpecOnValid , eqSpecOnInvalid , eqSpec , eqSpecOnArbitrary , eqSpecOnGen -- * Ord properties , ordSpecOnGen , ordSpecOnValid , ordSpecOnInvalid , ordSpec , ordSpecOnArbitrary -- * Monoid properties , monoidSpecOnValid , monoidSpec , monoidSpecOnArbitrary , monoidSpecOnGen -- * Functor properties , functorSpecOnValid , functorSpec , functorSpecOnArbitrary , functorSpecOnGens -- * Applicative properties , applicativeSpecOnValid , applicativeSpec , applicativeSpecOnArbitrary , applicativeSpecOnGens -- * Monad properties , monadSpecOnValid , 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.GenRelativeValidity 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.RelativeValidity import Test.Validity.Show import Test.Validity.Shrinking import Test.Validity.Utils genvalidity-hspec-0.7.0.4/src/Test/Validity/Applicative.hs0000644000000000000000000002053213612602711021556 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE AllowAmbiguousTypes #-} -- | Applicative properties -- -- You will need @TypeApplications@ to use these. module Test.Validity.Applicative ( applicativeSpecOnValid , applicativeSpec , applicativeSpecOnArbitrary , applicativeSpecOnGens ) where import Data.Data import Data.GenValidity import Test.Hspec import Test.QuickCheck import Test.Validity.Functions import Test.Validity.Utils {-# ANN module "HLint: ignore Avoid lambda" #-} pureTypeStr :: forall (f :: * -> *). (Typeable f) => String pureTypeStr = unwords ["pure", "::", "a", "->", nameOf @f, "a"] seqTypeStr :: forall (f :: * -> *). (Typeable f) => String seqTypeStr = unwords [ "(<*>)" , "::" , nameOf @f , "(a" , "->" , "b)" , "->" , nameOf @f , "a" , "->" , nameOf @f , "b" ] seqrTypeStr :: forall (f :: * -> *). (Typeable f) => String seqrTypeStr = unwords [ "(*>)" , "::" , nameOf @f , "a" , "->" , nameOf @f , "b" , "->" , nameOf @f , "b" ] seqlTypeStr :: forall (f :: * -> *). (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 @[] applicativeSpecOnValid :: forall (f :: * -> *). (Eq (f Int), Show (f Int), Applicative f, Typeable f, GenValid (f Int)) => Spec applicativeSpecOnValid = applicativeSpecWithInts @f genValid -- | Standard test spec for properties of Applicative instances for values generated with GenUnchecked instances -- -- Example usage: -- -- > applicativeSpecOnArbitrary @[] applicativeSpec :: forall (f :: * -> *). ( Eq (f Int) , Show (f Int) , Applicative f , Typeable f , GenUnchecked (f Int) ) => Spec applicativeSpec = applicativeSpecWithInts @f genUnchecked -- | Standard test spec for properties of Applicative instances for values generated with Arbitrary instances -- -- Example usage: -- -- > applicativeSpecOnArbitrary @[] applicativeSpecOnArbitrary :: forall (f :: * -> *). (Eq (f Int), Show (f Int), Applicative f, Typeable f, Arbitrary (f Int)) => Spec applicativeSpecOnArbitrary = applicativeSpecWithInts @f arbitrary applicativeSpecWithInts :: forall (f :: * -> *). (Show (f Int), Eq (f Int), Applicative f, Typeable f) => Gen (f Int) -> Spec applicativeSpecWithInts gen = applicativeSpecOnGens @f @Int genUnchecked "int" gen (unwords [nameOf @f, "of ints"]) gen (unwords [nameOf @f, "of ints"]) ((+) <$> genUnchecked) "increments" (pure <$> ((+) <$> genUnchecked)) (unwords [nameOf @f, "of increments"]) (pure <$> ((*) <$> genUnchecked)) (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 :: * -> *) (a :: *) (b :: *) (c :: *). ( Show a , Eq 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 = 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 *> 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-0.7.0.4/src/Test/Validity/Arbitrary.hs0000644000000000000000000000224013612602711021250 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE AllowAmbiguousTypes #-} {-# 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-0.7.0.4/src/Test/Validity/Eq.hs0000644000000000000000000001022113612602711017654 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE AllowAmbiguousTypes #-} -- | Eq properties -- -- You will need @TypeApplications@ to use these. module Test.Validity.Eq ( eqSpecOnValid , eqSpecOnInvalid , 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: -- -- > eqSpecOnValid @Double eqSpecOnValid :: forall a. (Show a, Eq a, Typeable a, GenValid a) => Spec eqSpecOnValid = eqSpecOnGen @a genValid "valid" shrinkValid -- | Standard test spec for properties of Eq instances for invalid values -- -- Example usage: -- -- > eqSpecOnInvalid @Double eqSpecOnInvalid :: forall a. (Show a, Eq a, Typeable a, GenInvalid a) => Spec eqSpecOnInvalid = eqSpecOnGen @a genInvalid "invalid" shrinkInvalid -- | Standard test spec for properties of Eq instances for unchecked values -- -- Example usage: -- -- > eqSpec @Int eqSpec :: forall a. (Show a, Eq a, Typeable a, GenUnchecked a) => Spec eqSpec = eqSpecOnGen @a genUnchecked "unchecked" shrinkUnchecked -- | 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-0.7.0.4/src/Test/Validity/Functor.hs0000644000000000000000000001133313612602711020734 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE AllowAmbiguousTypes #-} -- | Functor properties -- -- You will need @TypeApplications@ to use these. module Test.Validity.Functor ( functorSpecOnValid , functorSpec , functorSpecOnArbitrary , functorSpecOnGens ) where import Data.Data import Data.GenValidity import Test.Hspec import Test.QuickCheck import Test.Validity.Functions import Test.Validity.Utils {-# ANN module "HLint: ignore Functor law" #-} fmapTypeStr :: forall (f :: * -> *). (Typeable f) => String fmapTypeStr = unwords [ "fmap" , "::" , "(a" , "->" , "b)" , "->" , nameOf @f , "a" , "->" , nameOf @f , "b" ] flTypeStr :: forall (f :: * -> *). (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 @[] functorSpecOnValid :: forall (f :: * -> *). (Eq (f Int), Show (f Int), Functor f, Typeable f, GenValid (f Int)) => Spec functorSpecOnValid = functorSpecWithInts @f genValid -- | Standard test spec for properties of Functor instances for values generated with GenUnchecked instances -- -- Example usage: -- -- > functorSpecOnArbitrary @[] functorSpec :: forall (f :: * -> *). (Eq (f Int), Show (f Int), Functor f, Typeable f, GenUnchecked (f Int)) => Spec functorSpec = functorSpecWithInts @f genUnchecked -- | Standard test spec for properties of Functor instances for values generated with Arbitrary instances -- -- Example usage: -- -- > functorSpecOnArbitrary @[] functorSpecOnArbitrary :: forall (f :: * -> *). (Eq (f Int), Show (f Int), Functor f, Typeable f, Arbitrary (f Int)) => Spec functorSpecOnArbitrary = functorSpecWithInts @f arbitrary functorSpecWithInts :: forall (f :: * -> *). (Eq (f Int), Show (f Int), Functor f, Typeable f) => Gen (f Int) -> Spec functorSpecWithInts gen = functorSpecOnGens @f @Int genUnchecked "int" gen (unwords [nameOf @f, "of ints"]) ((+) <$> genUnchecked) "increments" ((*) <$> genUnchecked) "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 :: * -> *) (a :: *) (b :: *) (c :: *). ( 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-0.7.0.4/src/Test/Validity/GenRelativeValidity.hs0000644000000000000000000000662513612602711023237 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ScopedTypeVariables #-} -- | Tests for GenRelativeValidity instances -- -- You will need @TypeApplications@ to use these. module Test.Validity.GenRelativeValidity ( genRelativeValiditySpec , genRelativeValidSpec , genRelativeInvalidSpec , genRelativeValidGeneratesValid , genRelativeInvalidGeneratesInvalid ) where import Data.Data import Data.GenRelativeValidity import Data.GenValidity import Test.Hspec import Test.QuickCheck import Test.Validity.Property.Utils import Test.Validity.Utils -- | A @Spec@ that specifies that @genValidFor@ and @genInvalidFor@ work as -- intended. -- -- In general it is a good idea to add this spec to your test suite if you -- write a custom implementation of @genValidFor@ or @genInvalidFor@. -- -- Example usage: -- -- > relativeGenValiditySpec @MyDataFor @MyOtherData genRelativeValiditySpec :: forall a b. ( Typeable a , Typeable b , Show a , Show b , GenUnchecked b , GenValid b , GenRelativeValid a b , GenRelativeInvalid a b ) => Spec genRelativeValiditySpec = do genRelativeValidSpec @a @b genRelativeInvalidSpec @a @b genRelativeValidSpec :: forall a b. ( Typeable a , Typeable b , Show a , Show b , GenValid a , GenValid b , RelativeValidity a b , GenRelativeValid a b ) => Spec genRelativeValidSpec = parallel $ do let nameOne = nameOf @a let nameTwo = nameOf @a describe ("GenRelativeValidity " ++ nameOne ++ " " ++ nameTwo) $ describe ("genValidFor :: " ++ nameTwo ++ " -> Gen " ++ nameOne) $ it ("only generates valid \'" ++ nameOne ++ "\'s for the " ++ nameTwo) $ genRelativeValidGeneratesValid @a @b genRelativeInvalidSpec :: forall a b. ( Typeable a , Typeable b , Show a , Show b , GenValid a , GenUnchecked b , GenValid b , RelativeValidity a b , GenRelativeInvalid a b ) => Spec genRelativeInvalidSpec = parallel $ do let nameOne = nameOf @a let nameTwo = nameOf @a describe ("GenRelativeInvalid " ++ nameOne ++ " " ++ nameTwo) $ describe ("genInvalidFor :: " ++ nameTwo ++ " -> Gen " ++ nameOne) $ it ("only generates invalid \'" ++ nameOne ++ "\'s for the " ++ nameTwo) $ genRelativeInvalidGeneratesInvalid @a @b -- | @genValidFor b@ only generates values that satisfy @isValidFor b@ genRelativeValidGeneratesValid :: forall a b. (Show a, Show b, GenValid b, RelativeValidity a b, GenRelativeValid a b) => Property genRelativeValidGeneratesValid = forAllValid $ \(b :: b) -> forAll (genValidFor b) $ \(a :: a) -> a `shouldSatisfy` (`isValidFor` b) -- | @genInvalidFor b@ only generates values that do not satisfy @isValidFor b@ genRelativeInvalidGeneratesInvalid :: forall a b. ( Show a , Show b , GenUnchecked b , RelativeValidity a b , GenRelativeInvalid a b ) => Property genRelativeInvalidGeneratesInvalid = forAllUnchecked $ \(b :: b) -> forAll (genInvalidFor b) $ \(a :: a) -> a `shouldNotSatisfy` (`isValidFor` b) genvalidity-hspec-0.7.0.4/src/Test/Validity/GenValidity.hs0000644000000000000000000000650613612602711021541 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ScopedTypeVariables #-} -- | Tests for GenValidity instances -- -- You will need @TypeApplications@ to use these. module Test.Validity.GenValidity ( genValiditySpec , genValidSpec , genInvalidSpec , genValidGeneratesValid , genGeneratesValid , genInvalidGeneratesInvalid , 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 for properties of 'GenValid' and 'GenInvalid' instances. -- -- In general it is a good idea to add this spec to your test suite if you -- write a custom implementation of @genValid@ or @genInvalid@. -- -- __It is not a good idea to use this function if invalid values are broken in such a way that 'Show' or even 'isValid' is broken.__ -- In that case you probably want 'genValidSpec'. -- -- Example usage: -- -- > genValiditySpec @Int genValiditySpec :: forall a. (Typeable a, Show a, GenValid a, GenInvalid a) => Spec genValiditySpec = do genValidSpec @a genInvalidSpec @a -- | 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 -- | A @Spec@ that specifies that @genInvalid@ only generates invalid data. -- -- Note that it is not a good idea to use this function if invalid values are broken in such a way that 'Show' or even 'isValid' is broken. -- -- Example usage: -- -- > genInvalidSpec @Rational genInvalidSpec :: forall a. (Typeable a, Show a, GenInvalid a) => Spec genInvalidSpec = parallel $ do let name = nameOf @a describe ("GenInvalid " ++ name) $ describe ("genInvalid :: Gen " ++ name) $ it ("only generates invalid \'" ++ name ++ "\'s") $ genInvalidGeneratesInvalid @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 -- | @genValid@ only generates invalid data -- -- prop> genInvalidGeneratesInvalid @Rational -- prop> genInvalidGeneratesInvalid @Rational -- prop> genInvalidGeneratesInvalid @(Maybe Rational) -- prop> genInvalidGeneratesInvalid @[Rational] genInvalidGeneratesInvalid :: forall a. (Show a, GenInvalid a) => Property genInvalidGeneratesInvalid = genGeneratesInvalid @a genInvalid genvalidity-hspec-0.7.0.4/src/Test/Validity/Monad.hs0000644000000000000000000001671313620324062020360 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE AllowAmbiguousTypes #-} -- | Monad properties -- -- You will need @TypeApplications@ to use these. module Test.Validity.Monad ( monadSpecOnValid , monadSpec , monadSpecOnArbitrary , monadSpecOnGens ) where import Data.Data import Control.Monad (ap) import Data.GenValidity import Test.QuickCheck.Gen (unGen) import Test.QuickCheck.Random (mkQCGen) import Test.Hspec import Test.QuickCheck 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 :: * -> *). (Typeable m) => String returnTypeStr = unwords ["return", "::", "a", "->", nameOf @m, "a"] bindTypeStr :: forall (m :: * -> *). (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: -- -- > monadSpecOnValid @[] monadSpecOnValid :: forall (f :: * -> *). (Eq (f Int), Show (f Int), Monad f, Typeable f, GenValid (f Int)) => Spec monadSpecOnValid = monadSpecWithInts @f genValid -- | Standard test spec for properties of Monad instances for values generated with GenUnchecked instances -- -- Example usage: -- -- > monadSpec @[] monadSpec :: forall (f :: * -> *). (Eq (f Int), Show (f Int), Monad f, Typeable f, GenUnchecked (f Int)) => Spec monadSpec = monadSpecWithInts @f genUnchecked -- | Standard test spec for properties of Monad instances for values generated with Arbitrary instances -- -- Example usage: -- -- > monadSpecOnArbitrary @[] monadSpecOnArbitrary :: forall (f :: * -> *). (Eq (f Int), Show (f Int), Monad f, Typeable f, Arbitrary (f Int)) => Spec monadSpecOnArbitrary = monadSpecWithInts @f arbitrary monadSpecWithInts :: forall (f :: * -> *). (Eq (f Int), Show (f Int), Monad f, Typeable f) => Gen (f Int) -> Spec monadSpecWithInts gen = monadSpecOnGens @f @Int genUnchecked "int" gen (unwords [nameOf @f, "of ints"]) gen (unwords [nameOf @f, "of ints"]) ((+) <$> genUnchecked) "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 <$> ((+) <$> genUnchecked)) (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 :: * -> *) (a :: *) (b :: *) (c :: *). ( Show a , Eq 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-0.7.0.4/src/Test/Validity/Monoid.hs0000644000000000000000000000706013612602711020543 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE AllowAmbiguousTypes #-} -- | 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 unchecked values -- -- Example usage: -- -- > monoidSpec @[Int] monoidSpec :: forall a. (Show a, Eq a, Monoid a, Typeable a, GenUnchecked a) => Spec monoidSpec = monoidSpecOnGen @a genUnchecked "unchecked" shrinkUnchecked -- | 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-0.7.0.4/src/Test/Validity/Ord.hs0000644000000000000000000001235013612602711020040 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE AllowAmbiguousTypes #-} -- | Ord properties -- -- You will need @TypeApplications@ to use these. module Test.Validity.Ord ( ordSpecOnGen , ordSpecOnValid , ordSpecOnInvalid , ordSpec , 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: -- -- > ordSpecOnValid @Double ordSpecOnValid :: forall a. (Show a, Ord a, Typeable a, GenValid a) => Spec ordSpecOnValid = ordSpecOnGen @a genValid "valid" shrinkValid -- | Standard test spec for properties of Ord instances for invalid values -- -- Example usage: -- -- > ordSpecOnInvalid @Double ordSpecOnInvalid :: forall a. (Show a, Ord a, Typeable a, GenInvalid a) => Spec ordSpecOnInvalid = ordSpecOnGen @a genInvalid "invalid" shrinkInvalid -- | Standard test spec for properties of Ord instances for unchecked values -- -- Example usage: -- -- > ordSpec @Int ordSpec :: forall a. (Show a, Ord a, Typeable a, GenUnchecked a) => Spec ordSpec = ordSpecOnGen @a genUnchecked "unchecked" shrinkUnchecked -- | 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, Eq 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-0.7.0.4/src/Test/Validity/RelativeValidity.hs0000644000000000000000000000465313612602711022604 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ScopedTypeVariables #-} -- | Tests for RelativeValidity instances -- -- You will need @TypeApplications@ to use these. module Test.Validity.RelativeValidity ( relativeValiditySpec , relativeValidityImpliesValidA , relativeValidityImpliesValidB ) where import Data.Data import Data.GenRelativeValidity import Data.GenValidity import Test.Hspec import Test.QuickCheck import Test.Validity.Property.Utils import Test.Validity.Utils -- | A @Spec@ that specifies that @isValidFor@ implies @isValid@ -- -- In general it is a good idea to add this spec to your test suite if -- the @a@ and @b@ in @RelativeValidity a b@ also have a @Validity@ instance. -- -- Example usage: -- -- > relativeValiditySpec @MyDataFor @MyOtherData relativeValiditySpec :: forall a b. ( Typeable a , Typeable b , Show a , Show b , Validity a , Validity b , GenUnchecked a , GenUnchecked b , RelativeValidity a b ) => Spec relativeValiditySpec = parallel $ do let nameOne = nameOf @a nameTwo = nameOf @b describe ("RelativeValidity " ++ nameOne ++ " " ++ nameTwo) $ describe ("isValidFor :: " ++ nameOne ++ " -> " ++ nameTwo ++ " -> Bool") $ do it ("implies isValid " ++ nameOne ++ " for any " ++ nameTwo) $ relativeValidityImpliesValidA @a @b it ("implies isValid " ++ nameTwo ++ " for any " ++ nameOne) $ relativeValidityImpliesValidB @a @b -- | @isValidFor a b@ implies @isValid a@ for all @b@ relativeValidityImpliesValidA :: forall a b. ( Show a , Show b , Validity a , GenUnchecked a , GenUnchecked b , RelativeValidity a b ) => Property relativeValidityImpliesValidA = forAllUnchecked $ \(a :: a) -> forAllUnchecked $ \(b :: b) -> (a `isValidFor` b) ===> isValid a -- | @isValidFor a b@ implies @isValid b@ for all @a@ relativeValidityImpliesValidB :: forall a b. ( Show a , Show b , Validity b , GenUnchecked a , GenUnchecked b , RelativeValidity a b ) => Property relativeValidityImpliesValidB = forAllUnchecked $ \(a :: a) -> forAllUnchecked $ \(b :: b) -> (a `isValidFor` b) ===> isValid b genvalidity-hspec-0.7.0.4/src/Test/Validity/Show.hs0000644000000000000000000000573513612602711020245 0ustar0000000000000000{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} -- | 'Show' and 'Read' properties module Test.Validity.Show ( showReadSpecOnValid , showReadSpec , showReadSpecOnArbitrary , showReadSpecOnGen , showReadRoundTripOnValid , showReadRoundTrip , showReadRoundTripOnArbitrary , showReadRoundTripOnGen ) where import Data.GenValidity import Data.Data import Text.Read import Test.Hspec import Test.QuickCheck import Test.Validity.Utils -- | Standard test spec for properties of Show and Read instances for valid values -- -- Example usage: -- -- > showReadSpecOnValid @Double showReadSpecOnValid :: forall a. (Show a, Eq a, Read a, Typeable a, GenValid a) => Spec showReadSpecOnValid = showReadSpecOnGen @a genValid "valid" shrinkValid -- | Standard test spec for properties of Show and Read instances for unchecked values -- -- Example usage: -- -- > showReadSpec @Int showReadSpec :: forall a. (Show a, Eq a, Read a, Typeable a, GenUnchecked a) => Spec showReadSpec = showReadSpecOnGen @a genUnchecked "unchecked" shrinkUnchecked -- | 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> showReadRoundTripOnValid @Rational showReadRoundTripOnValid :: forall a. (Show a, Eq a, Read a, GenValid a) => Property showReadRoundTripOnValid = showReadRoundTripOnGen (genValid :: Gen a) shrinkValid -- | -- -- prop> showReadRoundTrip @Int showReadRoundTrip :: forall a. (Show a, Eq a, Read a, GenUnchecked a) => Property showReadRoundTrip = showReadRoundTripOnGen (genUnchecked :: Gen a) shrinkUnchecked -- | -- -- prop> showReadRoundTripOnArbitrary @Double showReadRoundTripOnArbitrary :: forall a. (Show a, Eq a, Read a, Arbitrary a) => Property showReadRoundTripOnArbitrary = showReadRoundTripOnGen (arbitrary :: Gen a) shrink -- | -- -- prop> showReadRoundTripOnGen (abs <$> genUnchecked :: 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-0.7.0.4/src/Test/Validity/Shrinking.hs0000644000000000000000000001074213612602711021253 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ScopedTypeVariables #-} -- | Tests for Shrinking functions -- -- You will need @TypeApplications@ to use these. module Test.Validity.Shrinking ( shrinkValiditySpec , shrinkValidSpec , shrinkValidSpecWithLimit , shrinkInvalidSpec , shrinkValidPreservesValidOnGenValid , shrinkValidPreservesValidOnGenValidWithLimit , shrinkInvalidPreservesInvalidOnGenInvalid , shrinkPreservesValidOnGenValid , shrinkPreservesInvalidOnGenInvalid , shrinkValidPreservesValid , shrinkInvalidPreservesInvalid , shrinkingStaysValid , shrinkingStaysInvalid , shrinkingPreserves , shrinkUncheckedDoesNotShrinkToItself , shrinkUncheckedDoesNotShrinkToItselfWithLimit , shrinkValidDoesNotShrinkToItself , shrinkValidDoesNotShrinkToItselfWithLimit , shrinkInvalidDoesNotShrinkToItself , shrinkInvalidDoesNotShrinkToItselfWithLimit ) where import Data.Data import Data.GenValidity import Control.Monad import Test.Hspec import Test.QuickCheck import Test.Validity.Shrinking.Property import Test.Validity.Utils shrinkValiditySpec :: forall a. (Show a, Eq a, Typeable a, GenValid a, GenInvalid a) => Spec shrinkValiditySpec = do shrinkValidSpec @a shrinkInvalidSpec @a 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, GenUnchecked 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 shrinkInvalidSpec :: forall a. (Show a, Typeable a, GenInvalid a) => Spec shrinkInvalidSpec = describe ("shrinkInvalid :: " ++ nameOf @(a -> [a])) $ do it "preserves invalidity" $ forAll (genInvalid @a) $ \a -> forM_ (shrinkInvalid a) shouldBeInvalid 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 shrinkInvalidPreservesInvalidOnGenInvalid :: forall a. (Show a, GenInvalid a) => Property shrinkInvalidPreservesInvalidOnGenInvalid = shrinkingStaysInvalid @a genInvalid shrinkInvalid shrinkUncheckedDoesNotShrinkToItself :: forall a. (Show a, Eq a, GenUnchecked a) => Property shrinkUncheckedDoesNotShrinkToItself = shrinkDoesNotShrinkToItself @a shrinkUnchecked shrinkValidDoesNotShrinkToItself :: forall a. (Show a, Eq a, GenValid a) => Property shrinkValidDoesNotShrinkToItself = shrinkDoesNotShrinkToItselfOnValid @a shrinkValid shrinkInvalidDoesNotShrinkToItself :: forall a. (Show a, Eq a, GenInvalid a) => Property shrinkInvalidDoesNotShrinkToItself = shrinkDoesNotShrinkToItselfOnInvalid @a shrinkInvalid shrinkInvalidDoesNotShrinkToItselfWithLimit :: forall a. (Show a, Eq a, GenUnchecked a, GenInvalid a) => Int -> Property shrinkInvalidDoesNotShrinkToItselfWithLimit = shrinkDoesNotShrinkToItselfWithLimit @a shrinkInvalid shrinkValidDoesNotShrinkToItselfWithLimit :: forall a. (Show a, Eq a, GenUnchecked a, GenValid a) => Int -> Property shrinkValidDoesNotShrinkToItselfWithLimit = shrinkDoesNotShrinkToItselfWithLimit @a shrinkValid shrinkUncheckedDoesNotShrinkToItselfWithLimit :: forall a. (Show a, Eq a, GenUnchecked a) => Int -> Property shrinkUncheckedDoesNotShrinkToItselfWithLimit = shrinkDoesNotShrinkToItselfWithLimit @a shrinkUnchecked genvalidity-hspec-0.7.0.4/src/Test/Validity/Utils.hs0000644000000000000000000000726513620324650020427 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE CPP #-} -- | 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.Monad.Trans.Writer (mapWriterT) import Control.Arrow (second) 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 mapSpecTree' f (SpecM specs) = SpecM (mapWriterT (fmap (second (map f))) specs) -- | 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 #if MIN_VERSION_hspec_core(2,6,0) , itemIsFocused = False #endif #if MIN_VERSION_hspec_core(2,5,0) , itemIsParallelizable = Nothing #else , itemIsParallelizable = False #endif , itemExample = \_ _ _ -> do let conf = defaultConfig {configFormatter = Just silent} r <- hspecWithResult conf $ fromSpecList [sp] let succesful = summaryExamples r > 0 && summaryFailures r > 0 pure $ produceResult succesful } #if MIN_VERSION_hspec_core(2,4,0) #if MIN_VERSION_hspec_core(2,5,0) produceResult :: Bool -> Test.Hspec.Core.Spec.Result produceResult succesful = Result { resultInfo = "" , resultStatus = if succesful then Success else Failure Nothing $ Reason "Should have failed but didn't." } #else produceResult :: Bool -> Either a Test.Hspec.Core.Spec.Result produceResult succesful = Right $ if succesful then Success else Failure Nothing $ Reason "Should have failed but didn't." #endif #else produceResult :: Bool -> Test.Hspec.Core.Spec.Result produceResult succesful = if succesful then Success else Fail Nothing "Should have failed but didn't." #endif shouldFail :: Property -> Property shouldFail = mapResult $ \res -> res { reason = unwords ["Should have failed:", reason res] , expect = not $ expect res } genvalidity-hspec-0.7.0.4/test/Spec.hs0000644000000000000000000000005413612602711015670 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} genvalidity-hspec-0.7.0.4/test/Test/Validity/ApplicativeSpec.hs0000644000000000000000000000217313612602711022562 0ustar0000000000000000{-# LANGUAGE TypeApplications #-} module Test.Validity.ApplicativeSpec where import Test.Hspec import Data.GenValidity import Test.Validity.Applicative spec :: Spec spec = do applicativeSpecOnValid @[] applicativeSpecOnValid @Maybe 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-0.7.0.4/test/Test/Validity/ArbitrarySpec.hs0000644000000000000000000000024713612602711022260 0ustar0000000000000000{-# LANGUAGE TypeApplications #-} module Test.Validity.ArbitrarySpec where import Test.Hspec import Test.Validity.Arbitrary spec :: Spec spec = arbitrarySpec @Int genvalidity-hspec-0.7.0.4/test/Test/Validity/EqSpec.hs0000644000000000000000000000147113612602711020666 0ustar0000000000000000{-# LANGUAGE TypeApplications #-} -- | Standard 'Spec's for 'Eq' instances. -- -- You will need @TypeApplications@ to use these. module Test.Validity.EqSpec where import Test.Hspec import Data.GenValidity import Test.Validity.Eq import Test.Validity.Utils spec :: Spec spec = do eqSpecOnValid @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) instance Eq EqFuncMismatch where (==) _ _ = True (/=) _ _ = True instance GenUnchecked EqFuncMismatch where genUnchecked = EqFuncMismatch <$> genUnchecked shrinkUnchecked _ = [] genvalidity-hspec-0.7.0.4/test/Test/Validity/FunctorSpec.hs0000644000000000000000000000230213612602711021733 0ustar0000000000000000{-# LANGUAGE TypeApplications #-} module Test.Validity.FunctorSpec where import Test.Hspec import Data.GenValidity 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) functorSpecOnValid @[] functorSpecOnValid @Maybe 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) instance GenUnchecked (Fcks a) where genUnchecked = Fcks <$> genUnchecked shrinkUnchecked (Fcks i) = Fcks <$> shrinkUnchecked i instance Functor Fcks where fmap _ (Fcks i) = Fcks $ i * 2 genvalidity-hspec-0.7.0.4/test/Test/Validity/GenRelativeValiditySpec.hs0000644000000000000000000000030013612602711024222 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-0.7.0.4/test/Test/Validity/GenValiditySpec.hs0000644000000000000000000000036113612602711022535 0ustar0000000000000000{-# LANGUAGE TypeApplications #-} module Test.Validity.GenValiditySpec where import Test.Hspec import Test.Validity.GenValidity spec :: Spec spec = do genValiditySpec @Rational genValidSpec @Rational genInvalidSpec @Rational genvalidity-hspec-0.7.0.4/test/Test/Validity/MonadSpec.hs0000644000000000000000000000225213612602711021355 0ustar0000000000000000{-# LANGUAGE TypeApplications #-} module Test.Validity.MonadSpec where import Test.Hspec import Data.GenValidity import Test.Validity.Monad {-# ANN module "HLint: ignore Use :" #-} spec :: Spec spec = do monadSpec @[] monadSpec @Maybe monadSpec @(Either Int) monadSpecOnValid @[] monadSpecOnValid @Maybe 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-0.7.0.4/test/Test/Validity/MonoidSpec.hs0000644000000000000000000000045413612602711021546 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-0.7.0.4/test/Test/Validity/OrdSpec.hs0000644000000000000000000000057613612602711021052 0ustar0000000000000000{-# LANGUAGE TypeApplications #-} module Test.Validity.OrdSpec where import Test.Hspec import Data.GenValidity import Test.Validity.Ord import Test.Validity.Utils spec :: Spec spec = do ordSpecOnValid @Rational failsBecause "NaN >= NaN is False" $ ordSpec @Double ordSpec @Int ordSpecOnArbitrary @Int ordSpecOnGen ((* 2) <$> genValid @Int) "even" (const []) genvalidity-hspec-0.7.0.4/test/Test/Validity/RelativeValiditySpec.hs0000644000000000000000000000021113612602711023571 0ustar0000000000000000module Test.Validity.RelativeValiditySpec where import Test.Hspec -- import Test.Validity.RelativeValidity spec :: Spec spec = pure () genvalidity-hspec-0.7.0.4/test/Test/Validity/ShowSpec.hs0000644000000000000000000000147113612602711021241 0ustar0000000000000000{-# LANGUAGE TypeApplications #-} -- | Standard 'Spec's for 'Show' and 'Read' instances. -- -- You will need @TypeApplications@ to use these. module Test.Validity.ShowSpec where import Test.Hspec import Data.GenValidity import Test.Validity.Show import Test.Validity.Utils spec :: Spec spec = do showReadSpecOnValid @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) instance Show ShowFuncMismatch where show ShowFuncMismatch = "wrong" instance GenUnchecked ShowFuncMismatch where genUnchecked = pure ShowFuncMismatch shrinkUnchecked _ = [] genvalidity-hspec-0.7.0.4/test/Test/Validity/ShrinkingSpec.hs0000644000000000000000000000231613620324062022253 0ustar0000000000000000{-# LANGUAGE TypeApplications #-} module Test.Validity.ShrinkingSpec where import Test.Hspec import Data.Int import Data.Ratio import Test.Validity.Shrinking spec :: Spec spec = do shrinkValiditySpec @(Ratio Int8) shrinkValidSpec @Int shrinkInvalidSpec @(Ratio Int8) describe "shrinkUncheckedPreservesValidOnGenValid" $ do it "Ordering" $ shrinkValidPreservesValidOnGenValid @Ordering it "[Ordering]" $ shrinkValidPreservesValidOnGenValid @[Ordering] describe "shrinkValidPreservesValidOnGenValid" $ do it "Ordering" $ shrinkValidPreservesValidOnGenValid @Ordering it "[Ordering]" $ shrinkValidPreservesValidOnGenValid @[Ordering] describe "shrinkInvalidPreservesInvalidOnGenInvalid" $ do it "Ordering" $ shrinkInvalidPreservesInvalidOnGenInvalid @(Ratio Int8) it "[Ordering]" $ shrinkInvalidPreservesInvalidOnGenInvalid @[Ratio Int8] describe "shrinkUncheckedDoesNotShrinkToItself" $ do it "Int" $ shrinkUncheckedDoesNotShrinkToItself @Int it "[Int]" $ shrinkUncheckedDoesNotShrinkToItself @[Int] describe "shrinkValidDoesNotShrinkToItself" $ do it "Ordering" $ shrinkValidDoesNotShrinkToItself @Ordering it "[Ordering]" $ shrinkValidDoesNotShrinkToItself @[Ordering] genvalidity-hspec-0.7.0.4/LICENSE0000644000000000000000000000210413620324062014465 0ustar0000000000000000The MIT License (MIT) Copyright (c) 2016-2020 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-0.7.0.4/Setup.hs0000644000000000000000000000005713612602711015122 0ustar0000000000000000import Distribution.Simple main = defaultMain genvalidity-hspec-0.7.0.4/genvalidity-hspec.cabal0000644000000000000000000000545713620331574020107 0ustar0000000000000000cabal-version: 1.12 -- This file has been generated from package.yaml by hpack version 0.33.0. -- -- see: https://github.com/sol/hpack -- -- hash: f5acdda3f053861f0ebdb215817b65bc55fa4b9999a323a9875e7728b8b8f8f1 name: genvalidity-hspec version: 0.7.0.4 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-2020 Tom Sydney Kerckhove license: MIT license-file: LICENSE build-type: Simple extra-source-files: 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.GenRelativeValidity Test.Validity.GenValidity Test.Validity.Monad Test.Validity.Monoid Test.Validity.Ord Test.Validity.RelativeValidity Test.Validity.Show Test.Validity.Shrinking Test.Validity.Utils other-modules: Paths_genvalidity_hspec hs-source-dirs: src build-depends: QuickCheck , base >=4.9 && <5 , genvalidity >=0.8 , genvalidity-property >=0.5 , hspec , hspec-core , 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 default-language: Haskell2010 genvalidity-hspec-0.7.0.4/CHANGELOG.md0000644000000000000000000000144513620325360015302 0ustar0000000000000000# Changelog ## [Unreleased] ## [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