module Test.Hspec.Hashable (
testHashableUniqueness
, testHashableUniquenessWithoutTypeable
, testSelfEquality
, testHashableCollision
, dupsByMatchingSnd
) where
import Control.Arrow ((&&&))
import Data.Hashable
import Data.List
import Data.Proxy
import Data.Typeable
import Test.Hspec
import Test.QuickCheck
testHashableUniqueness :: forall a. (Arbitrary a, Eq a, Hashable a, Show a, Typeable a)
=> Int -> Proxy a -> Spec
testHashableUniqueness sampleSize proxy = do
case sampleSize <= 0 of
True -> fail ("The sample size must be greater than zero. The sample size you provided is: " ++ show sampleSize ++ ".")
False -> do
testSelfEquality sampleSize typeName proxy
testHashableCollision sampleSize typeName proxy
where
typeName = show . typeRep $ proxy
testHashableUniquenessWithoutTypeable :: forall a. (Arbitrary a, Eq a, Hashable a, Show a)
=> Int -> String -> Proxy a -> Spec
testHashableUniquenessWithoutTypeable sampleSize typeName proxy = do
case sampleSize <= 0 of
True -> fail ("The sample size must be greater than zero. The sample size you provided is: " ++ show sampleSize ++ ".")
False -> do
testSelfEquality sampleSize typeName proxy
testHashableCollision sampleSize typeName proxy
testSelfEquality :: forall a. (Arbitrary a, Eq a, Hashable a, Show a)
=> Int -> String -> Proxy a -> Spec
testSelfEquality sampleSize typeName Proxy =
describe ("Values of " ++ typeName ++ " derive Eq.") $
it "all values should be equal to themself. " $ do
xs <- generate (vectorOf sampleSize (arbitrary :: Gen a))
(and $ (\x -> x == x) <$> xs) `shouldBe` True
testHashableCollision :: forall a. (Arbitrary a, Eq a, Hashable a, Show a)
=> Int -> String -> Proxy a -> Spec
testHashableCollision sampleSize typeName Proxy =
describe ("Hashed values of " ++ typeName) $
it "all non-equivalent values should have unique hashes" $ do
xs <- generate (vectorOf sampleSize (arbitrary :: Gen a))
let matchingHashesForUniqueXs = dupsByMatchingSnd [] $ (id &&& hash) <$> nub xs
matchingHashesForUniqueXs `shouldBe` []
dupsByMatchingSnd :: (Eq b) => [(a,b)] -> [(a,b)] -> [(a,b)]
dupsByMatchingSnd ys (x:xs) = newX ++ dupsByMatchingSnd (ys ++ [x]) xs
where
xDups = filter (\y -> (snd x) == (snd y)) (xs ++ ys)
newX = if length xDups > 0
then [x]
else []
dupsByMatchingSnd _ [] = []