genvalidity-hspec-1.0.0.4/src/0000755000000000000000000000000014552240067014253 5ustar0000000000000000genvalidity-hspec-1.0.0.4/src/Test/0000755000000000000000000000000014552240067015172 5ustar0000000000000000genvalidity-hspec-1.0.0.4/src/Test/Validity/0000755000000000000000000000000015007322650016752 5ustar0000000000000000genvalidity-hspec-1.0.0.4/test/0000755000000000000000000000000014552240067014443 5ustar0000000000000000genvalidity-hspec-1.0.0.4/test/Test/0000755000000000000000000000000014552240067015362 5ustar0000000000000000genvalidity-hspec-1.0.0.4/test/Test/Validity/0000755000000000000000000000000014552240067017147 5ustar0000000000000000genvalidity-hspec-1.0.0.4/src/Test/Validity.hs0000644000000000000000000001402114552240067017311 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.4/src/Test/Validity/Applicative.hs0000644000000000000000000001726714552240067021571 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.4/src/Test/Validity/Arbitrary.hs0000644000000000000000000000221514552240067021252 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.4/src/Test/Validity/Eq.hs0000644000000000000000000000616414625706051017670 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.4/src/Test/Validity/Functor.hs0000644000000000000000000001002114552240067020725 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.4/src/Test/Validity/GenValidity.hs0000644000000000000000000000316414552240067021536 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.4/src/Test/Validity/Monad.hs0000644000000000000000000001511414552240067020353 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.4/src/Test/Validity/Monoid.hs0000644000000000000000000000641014625706051020542 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.4/src/Test/Validity/Ord.hs0000644000000000000000000001032114625706051020035 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.4/src/Test/Validity/Show.hs0000644000000000000000000000444614552240067020243 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.4/src/Test/Validity/Shrinking.hs0000644000000000000000000000466514552240067021262 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.4/src/Test/Validity/Utils.hs0000644000000000000000000000636315007322650020416 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 {- ORMOLU_DISABLE -} -- | 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, #if MIN_VERSION_hspec(2,11,10) itemAnnotations = mempty, #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 } {- ORMOLU_ENABLE -} 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.4/test/Spec.hs0000644000000000000000000000005414552240067015670 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} genvalidity-hspec-1.0.0.4/test/Test/Validity/ApplicativeSpec.hs0000644000000000000000000000167314552240067022566 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.4/test/Test/Validity/ArbitrarySpec.hs0000644000000000000000000000024614552240067022257 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.4/test/Test/Validity/EqSpec.hs0000644000000000000000000000141614552240067020665 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.4/test/Test/Validity/FunctorSpec.hs0000644000000000000000000000215214552240067021736 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.4/test/Test/Validity/GenRelativeValiditySpec.hs0000644000000000000000000000030014552240067024222 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.4/test/Test/Validity/GenValiditySpec.hs0000644000000000000000000000031414552240067022533 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.4/test/Test/Validity/MonadSpec.hs0000644000000000000000000000174614552240067021364 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.4/test/Test/Validity/MonoidSpec.hs0000644000000000000000000000044314552240067021544 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.4/test/Test/Validity/OrdSpec.hs0000644000000000000000000000055414552240067021046 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.4/test/Test/Validity/RelativeValiditySpec.hs0000644000000000000000000000021114552240067023571 0ustar0000000000000000module Test.Validity.RelativeValiditySpec where import Test.Hspec -- import Test.Validity.RelativeValidity spec :: Spec spec = pure () genvalidity-hspec-1.0.0.4/test/Test/Validity/ShowSpec.hs0000644000000000000000000000141314552240067021235 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.4/test/Test/Validity/ShrinkingSpec.hs0000644000000000000000000000170114552240067022251 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.4/LICENSE0000644000000000000000000000210414552240067014466 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.4/CHANGELOG.md0000644000000000000000000000266315007324351015277 0ustar0000000000000000# Changelog ## [1.0.0.4] - 2022-10-04 ### Changed * Compatibility with `hspec >= 2.11.10`. ## [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.4/genvalidity-hspec.cabal0000644000000000000000000000534315007324351020067 0ustar0000000000000000cabal-version: 1.12 -- This file has been generated from package.yaml by hpack version 0.36.1. -- -- see: https://github.com/sol/hpack name: genvalidity-hspec version: 1.0.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-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