diff --git a/genvalidity-hspec-hashable.cabal b/genvalidity-hspec-hashable.cabal --- a/genvalidity-hspec-hashable.cabal +++ b/genvalidity-hspec-hashable.cabal @@ -1,17 +1,19 @@ -name: genvalidity-hspec-hashable -version: 0.0.0.0 -synopsis: Standard spec's for Hashable instances -description: Standard spec's for Hashable instances -homepage: https://github.com/NorfairKing/validity -license: MIT -license-file: LICENSE -author: Nick Van den Broeck -maintainer: syd.kerckhove@gmail.com -copyright: 2017 Tom Sydney Kerckhove -category: Testing -build-type: Simple -extra-source-files: README.md -cabal-version: >=1.10 +name: genvalidity-hspec-hashable +version: 0.1.0.0 +cabal-version: >=1.10 +build-type: Simple +license: MIT +license-file: LICENSE +copyright: 2017 Tom Sydney Kerckhove +maintainer: syd.kerckhove@gmail.com +homepage: https://github.com/NorfairKing/validity +synopsis: Standard spec's for Hashable instances +description: + Standard spec's for Hashable instances +category: Testing +author: Nick Van den Broeck +extra-source-files: + README.md source-repository head type: git @@ -21,13 +23,13 @@ exposed-modules: Test.Validity.Hashable build-depends: - base >= 4.9 && <5, - validity >=0.3 && <0.4, - genvalidity-hspec >=0.3 && <0.5, - genvalidity >=0.3 && <0.4, - genvalidity-property >= 0.0 && < 0.1, + base >=4.9 && <5, + validity >=0.4 && <0.5, + genvalidity-hspec >=0.5 && <0.6, + genvalidity >=0.4 && <0.5, + genvalidity-property >=0.1 && <0.2, hspec >=2.2 && <2.5, - hashable >= 1.2 && < 1.3, + hashable >=1.2 && <1.3, QuickCheck -any default-language: Haskell2010 hs-source-dirs: src @@ -38,25 +40,24 @@ build-depends: base -any, doctest >=0.11 && <0.12, - hashable >= 1.2 && < 1.3, + hashable >=1.2 && <1.3, genvalidity-hspec-hashable -any, QuickCheck -any default-language: Haskell2010 hs-source-dirs: test ghc-options: -threaded - test-suite genvalidity-hspec-hashable-test type: exitcode-stdio-1.0 main-is: Spec.hs build-depends: base -any, - genvalidity >=0.3 && <0.4, + genvalidity -any, genvalidity-hspec -any, genvalidity-hspec-hashable -any, - hashable >= 1.2 && < 1.3, - hspec, - hspec-core, - QuickCheck + hashable -any, + hspec -any, + hspec-core -any, + QuickCheck -any default-language: Haskell2010 hs-source-dirs: test/ other-modules: diff --git a/src/Test/Validity/Hashable.hs b/src/Test/Validity/Hashable.hs --- a/src/Test/Validity/Hashable.hs +++ b/src/Test/Validity/Hashable.hs @@ -14,9 +14,10 @@ , hashableSpecOnGen ) where +import Control.Monad import Data.Data import Data.Hashable -import Control.Monad +import Test.Validity.Property.Utils import Test.Validity.Utils import Data.GenValidity @@ -29,84 +30,78 @@ -- Example usage: -- -- > hashableSpecOnValid @Double -hashableSpecOnValid - :: forall a. - (Show a, Eq a, Typeable a, GenValid a, Hashable a) +hashableSpecOnValid :: + forall a. (Show a, Eq a, Typeable a, GenValid a, Hashable a) => Spec -hashableSpecOnValid = hashableSpecOnGen @a genValid "valid" +hashableSpecOnValid = hashableSpecOnGen @a genValid "valid" shrinkValid -- | Standard test spec for properties of Hashable instances for invalid values -- -- Example usage: -- -- > hashableSpecOnInvalid @Double -hashableSpecOnInvalid - :: forall a. - (Show a, Eq a, Typeable a, GenInvalid a, Hashable a) +hashableSpecOnInvalid :: + forall a. (Show a, Eq a, Typeable a, GenInvalid a, Hashable a) => Spec -hashableSpecOnInvalid = hashableSpecOnGen @a genInvalid "invalid" +hashableSpecOnInvalid = hashableSpecOnGen @a genInvalid "invalid" shrinkInvalid -- | Standard test spec for properties of Hashable instances for unchecked values -- -- Example usage: -- -- > hashableSpec @Int -hashableSpec - :: forall a. - (Show a, Eq a, Typeable a, GenUnchecked a, Hashable a) +hashableSpec :: + forall a. (Show a, Eq a, Typeable a, GenUnchecked a, Hashable a) => Spec -hashableSpec = hashableSpecOnGen @a genUnchecked "unchecked" +hashableSpec = hashableSpecOnGen @a genUnchecked "unchecked" shrinkUnchecked -- | Standard test spec for properties of Hashable instances for arbitrary values -- -- Example usage: -- -- > hashableSpecOnArbitrary @Int -hashableSpecOnArbitrary - :: forall a. - (Show a, Eq a, Typeable a, Arbitrary a, Hashable a) +hashableSpecOnArbitrary :: + forall a. (Show a, Eq a, Typeable a, Arbitrary a, Hashable a) => Spec -hashableSpecOnArbitrary = hashableSpecOnGen @a arbitrary "arbitrary" +hashableSpecOnArbitrary = hashableSpecOnGen @a arbitrary "arbitrary" shrink -- | Standard test spec for properties of Hashable instances for values generated by a given generator (and name for that generator). -- -- Example usage: -- -- > hashableSpecOnGen ((* 2) <$> genValid @Int) "even" -hashableSpecOnGen - :: forall a. - (Show a, Eq a, Typeable a, Hashable a) - => Gen a -> String -> Spec -hashableSpecOnGen gen genname = checkGen gen2 genname - where gen2 = (,) <$> gen <*> gen +hashableSpecOnGen :: + forall a. (Show a, Eq a, Typeable a, Hashable a) + => Gen a + -> String + -> (a -> [a]) + -> Spec +hashableSpecOnGen gen = checkGen $ (,) <$> gen <*> gen -- | Test spec like hashableSpecOnGen but with a special generator -- | which is documented to generate equal values by (==) most of the time. -checkGen - :: forall a. - (Show a, Eq a, Typeable a, Hashable a) - => Gen (a, a) -> String -> Spec -checkGen gen genname = parallel $ do +checkGen :: + forall a. (Show a, Eq a, Typeable a, Hashable a) + => Gen (a, a) + -> String + -> (a -> [a]) + -> Spec +checkGen gen genname s = + parallel $ do let name = nameOf @a - hashablestr = (unwords - ["hashWithSalt :: Int ->" - , name - , "-> Int"]) - describe ("Hashable " ++ name) $ do - describe hashablestr $ do - it - (unwords - [ "satisfies (a == b) => (hashWithSalt n a) ==" - ,"(hashWithSalt n b), for every n and for" - , genname - , name - ]) $ - forAll gen $ \(a1, a2) -> - forAll arbitrary $ \int -> - when (a1 == a2) $ - let hash = hashWithSalt int - in hash a1 `shouldBe` hash a2 - - - - + hashablestr = unwords ["hashWithSalt :: Int ->", name, "-> Int"] + describe ("Hashable " ++ name) $ + describe hashablestr $ + it + (unwords + [ "satisfies (a == b) => (hashWithSalt n a) ==" + , "(hashWithSalt n b), for every n and for" + , genname + , name + ]) $ + let ss (a,b) = (,) <$> s a <*> s b + in forAllShrink gen ss $ \(a1, a2) -> + forAllUnchecked $ \int -> + when (a1 == a2) $ + let h = hashWithSalt int + in h a1 `shouldBe` h a2 diff --git a/test/Test/Validity/HashableSpec.hs b/test/Test/Validity/HashableSpec.hs --- a/test/Test/Validity/HashableSpec.hs +++ b/test/Test/Validity/HashableSpec.hs @@ -6,10 +6,10 @@ -- You will need @TypeApplications@ to use these. module Test.Validity.HashableSpec where -import Test.Hspec import Data.Hashable -import Test.Validity.Utils import GHC.Generics +import Test.Hspec +import Test.Validity.Utils import Data.GenValidity import Test.Validity.Hashable @@ -20,10 +20,11 @@ hashableSpec @Int hashableSpecOnArbitrary @Int hashableSpec @HashableValid - failsBecause ("Two equal elements aren't hashed to the same value!") $ + failsBecause "Two equal elements aren't hashed to the same value!" $ hashableSpec @HashableInvalid -newtype HashableValid = HashableValid Int +newtype HashableValid = + HashableValid Int deriving (Show, Generic) hT :: Int -- Number used in the definition of HashableValid @@ -34,8 +35,9 @@ instance Hashable HashableValid where hashWithSalt n (HashableValid a) = (int ^ expo) `mod` hT - where int = 1 + (a `mod` hT) - expo = 1 + (n `mod` hT) + where + int = 1 + (a `mod` hT) + expo = 1 + (n `mod` hT) instance Validity HashableValid @@ -43,11 +45,13 @@ instance GenUnchecked HashableValid -newtype HashableInvalid = HashableInvalid Int +newtype HashableInvalid = + HashableInvalid Int deriving (Show, Generic) hF :: Int -- Numbers used in the definition of HashableInvalid hF = 8 + hM :: Int hM = 3 @@ -56,13 +60,12 @@ instance Hashable HashableInvalid where hashWithSalt n (HashableInvalid a) = (int ^ expo) `mod` hM - where int = 1 + (a `mod` hM) - expo = 1 + (n `mod` hM) + where + int = 1 + (a `mod` hM) + expo = 1 + (n `mod` hM) instance Validity HashableInvalid instance GenValid HashableInvalid instance GenUnchecked HashableInvalid - -