{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
module Test.Validity.Hashable
( hashableSpecOnValid
, hashableSpecOnInvalid
, hashableSpec
, hashableSpecOnArbitrary
, hashableSpecOnGen
) where
import Control.Monad
import Data.Data
import Data.Hashable
import Test.Validity.Property.Utils
import Test.Validity.Utils
import Data.GenValidity
import Test.Hspec
import Test.QuickCheck
hashableSpecOnValid ::
forall a. (Show a, Eq a, Typeable a, GenValid a, Hashable a)
=> Spec
hashableSpecOnValid = hashableSpecOnGen @a genValid "valid" shrinkValid
hashableSpecOnInvalid ::
forall a. (Show a, Eq a, Typeable a, GenInvalid a, Hashable a)
=> Spec
hashableSpecOnInvalid = hashableSpecOnGen @a genInvalid "invalid" shrinkInvalid
hashableSpec ::
forall a. (Show a, Eq a, Typeable a, GenUnchecked a, Hashable a)
=> Spec
hashableSpec = hashableSpecOnGen @a genUnchecked "unchecked" shrinkUnchecked
hashableSpecOnArbitrary ::
forall a. (Show a, Eq a, Typeable a, Arbitrary a, Hashable a)
=> Spec
hashableSpecOnArbitrary = hashableSpecOnGen @a arbitrary "arbitrary" shrink
hashableSpecOnGen ::
forall a. (Show a, Eq a, Typeable a, Hashable a)
=> Gen a
-> String
-> (a -> [a])
-> Spec
hashableSpecOnGen gen = checkGen $ (,) <$> gen <*> gen
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) $
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