{-# LANGUAGE ScopedTypeVariables #-}
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 :: Int -> Proxy a -> Spec
testHashableUniqueness Int
sampleSize Proxy a
proxy = do
case Int
sampleSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 of
Bool
True -> [Char] -> Spec
forall a. HasCallStack => [Char] -> a
error ([Char] -> Spec) -> [Char] -> Spec
forall a b. (a -> b) -> a -> b
$ [Char]
"The sample size must be greater than zero. The sample size you provided is: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
sampleSize [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"."
Bool
False -> do
Int -> [Char] -> Proxy a -> Spec
forall a.
(Arbitrary a, Eq a, Hashable a, Show a) =>
Int -> [Char] -> Proxy a -> Spec
testSelfEquality Int
sampleSize [Char]
typeName Proxy a
proxy
Int -> [Char] -> Proxy a -> Spec
forall a.
(Arbitrary a, Eq a, Hashable a, Show a) =>
Int -> [Char] -> Proxy a -> Spec
testHashableCollision Int
sampleSize [Char]
typeName Proxy a
proxy
where
typeName :: [Char]
typeName = TypeRep -> [Char]
forall a. Show a => a -> [Char]
show (TypeRep -> [Char]) -> (Proxy a -> TypeRep) -> Proxy a -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a -> [Char]) -> Proxy a -> [Char]
forall a b. (a -> b) -> a -> b
$ Proxy a
proxy
testHashableUniquenessWithoutTypeable :: forall a. (Arbitrary a, Eq a, Hashable a, Show a)
=> Int -> String -> Proxy a -> Spec
testHashableUniquenessWithoutTypeable :: Int -> [Char] -> Proxy a -> Spec
testHashableUniquenessWithoutTypeable Int
sampleSize [Char]
typeName Proxy a
proxy = do
case Int
sampleSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 of
Bool
True -> [Char] -> Spec
forall a. HasCallStack => [Char] -> a
error ([Char] -> Spec) -> [Char] -> Spec
forall a b. (a -> b) -> a -> b
$ [Char]
"The sample size must be greater than zero. The sample size you provided is: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
sampleSize [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"."
Bool
False -> do
Int -> [Char] -> Proxy a -> Spec
forall a.
(Arbitrary a, Eq a, Hashable a, Show a) =>
Int -> [Char] -> Proxy a -> Spec
testSelfEquality Int
sampleSize [Char]
typeName Proxy a
proxy
Int -> [Char] -> Proxy a -> Spec
forall a.
(Arbitrary a, Eq a, Hashable a, Show a) =>
Int -> [Char] -> Proxy a -> Spec
testHashableCollision Int
sampleSize [Char]
typeName Proxy a
proxy
testSelfEquality :: forall a. (Arbitrary a, Eq a, Hashable a, Show a)
=> Int -> String -> Proxy a -> Spec
testSelfEquality :: Int -> [Char] -> Proxy a -> Spec
testSelfEquality Int
sampleSize [Char]
typeName Proxy a
Proxy =
[Char] -> Spec -> Spec
forall a. HasCallStack => [Char] -> SpecWith a -> SpecWith a
describe ([Char]
"Values of " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
typeName [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" derive Eq.") (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$
[Char] -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"all values should be equal to themself. " (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ do
[a]
xs <- Gen [a] -> IO [a]
forall a. Gen a -> IO a
generate (Int -> Gen a -> Gen [a]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
sampleSize (Gen a
forall a. Arbitrary a => Gen a
arbitrary :: Gen a))
([Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (\a
x -> a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x) (a -> Bool) -> [a] -> [Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
xs) Bool -> Bool -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` Bool
True
testHashableCollision :: forall a. (Arbitrary a, Eq a, Hashable a, Show a)
=> Int -> String -> Proxy a -> Spec
testHashableCollision :: Int -> [Char] -> Proxy a -> Spec
testHashableCollision Int
sampleSize [Char]
typeName Proxy a
Proxy =
[Char] -> Spec -> Spec
forall a. HasCallStack => [Char] -> SpecWith a -> SpecWith a
describe ([Char]
"Hashed values of " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
typeName) (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$
[Char] -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"all non-equivalent values should have unique hashes" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ do
[a]
xs <- Gen [a] -> IO [a]
forall a. Gen a -> IO a
generate (Int -> Gen a -> Gen [a]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
sampleSize (Gen a
forall a. Arbitrary a => Gen a
arbitrary :: Gen a))
let matchingHashesForUniqueXs :: [(a, Int)]
matchingHashesForUniqueXs = [(a, Int)] -> [(a, Int)] -> [(a, Int)]
forall b a. Eq b => [(a, b)] -> [(a, b)] -> [(a, b)]
dupsByMatchingSnd [] ([(a, Int)] -> [(a, Int)]) -> [(a, Int)] -> [(a, Int)]
forall a b. (a -> b) -> a -> b
$ (a -> a
forall a. a -> a
id (a -> a) -> (a -> Int) -> a -> (a, Int)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& a -> Int
forall a. Hashable a => a -> Int
hash) (a -> (a, Int)) -> [a] -> [(a, Int)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> [a]
forall a. Eq a => [a] -> [a]
nub [a]
xs
[(a, Int)]
matchingHashesForUniqueXs [(a, Int)] -> [(a, Int)] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` []
dupsByMatchingSnd :: (Eq b) => [(a,b)] -> [(a,b)] -> [(a,b)]
dupsByMatchingSnd :: [(a, b)] -> [(a, b)] -> [(a, b)]
dupsByMatchingSnd [(a, b)]
ys ((a, b)
x:[(a, b)]
xs) = [(a, b)]
newX [(a, b)] -> [(a, b)] -> [(a, b)]
forall a. [a] -> [a] -> [a]
++ [(a, b)] -> [(a, b)] -> [(a, b)]
forall b a. Eq b => [(a, b)] -> [(a, b)] -> [(a, b)]
dupsByMatchingSnd ([(a, b)]
ys [(a, b)] -> [(a, b)] -> [(a, b)]
forall a. [a] -> [a] -> [a]
++ [(a, b)
x]) [(a, b)]
xs
where
xDups :: [(a, b)]
xDups = ((a, b) -> Bool) -> [(a, b)] -> [(a, b)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(a, b)
y -> ((a, b) -> b
forall a b. (a, b) -> b
snd (a, b)
x) b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== ((a, b) -> b
forall a b. (a, b) -> b
snd (a, b)
y)) ([(a, b)]
xs [(a, b)] -> [(a, b)] -> [(a, b)]
forall a. [a] -> [a] -> [a]
++ [(a, b)]
ys)
newX :: [(a, b)]
newX = if [(a, b)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(a, b)]
xDups Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
then [(a, b)
x]
else []
dupsByMatchingSnd [(a, b)]
_ [] = []