{-|
Module      : Test.Hspec.Hashable
Description : Hashable testing functions
Copyright   : (c) Plow Technologies, 2016
License     : BSD3
Maintainer  : mchaver@gmail.com
Stability   : Beta
-}

{-# LANGUAGE ScopedTypeVariables #-}

module Test.Hspec.Hashable (
  -- * Introduction
  -- $introduction

  -- * Main functions
  -- $main
    testHashableUniqueness
  , testHashableUniquenessWithoutTypeable
  , testSelfEquality
  , testHashableCollision

  -- * Internal help functions
  -- $helperfunctions
  , dupsByMatchingSnd
  ) where

import Control.Arrow ((&&&))

import Data.Hashable
import Data.List
import Data.Proxy
import Data.Typeable

import Test.Hspec
import Test.QuickCheck

-- $main

-- | the main testing function, give it a sampleSize larger than zero (or it will fail) and it
-- will produce arbitrary elements to test the uniqueness of the created hash
-- for a particular type. Should use a large sample size to help find hash collisions.
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

-- | same as 'testHashableUniqueness' but it does not require an instance
-- of typeable and you should pass the type name as a string so it appears
-- in the error message.
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

-- | test whether or not the Eq instances is defined such that any value
-- equals itself. If it does not, then the testHashableCollision
-- testing function might not work as expected.
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

-- | test whether or not there is are hash collisions between unique values.
-- if there are you need to fix your definition of Hashable.
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))
      -- nub : remove duplicates in xs
      -- (id &&& hash): put x and hash of x in a tuple
      -- dupsByMatchingSnd: get any tuples that have the same hash value but
      -- have unique (non-equivalent) x values.
      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
      -- if the Eq and Hashable instances are well defined, the list should be empty
      [(a, Int)]
matchingHashesForUniqueXs [(a, Int)] -> [(a, Int)] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` []


-- $helperfunctions

-- | filter a list by collecting all duplications of the second item of
-- the tuple and return both elements of the tuple.
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)]
_  []     = []


-- $introduction
--
-- For every 'Hashable' instance of a type, each unique value of that type
-- should have a unique hash. Generally, a 'Generic' 'Hashable' instance of a type should
-- create a unique hash, and ideally these match the rules of type's 'Eq'
-- instance. Any values for that type that are equal should have the same hash
-- and any values that are not equal should have unique hashes.
-- There might still be cases where a 'Generic' 'Hashable' instance
-- breaks those expectations. There are also cases where you might implement
-- 'Hashable' by hand. This testing library assumes that you expect the
-- uniqueness of a type matches in `Eq` and `Hashable`.