{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-- | Hashable properties
--
-- You will need @TypeApplications@ to use these.
module Test.Validity.Hashable
  ( hashableSpec,
    hashableSpecOnArbitrary,
    hashableSpecOnGen,
  )
where

import Control.Monad
import Data.Data
import Data.GenValidity
import Data.Hashable
import Test.Hspec
import Test.QuickCheck
import Test.Validity.Property.Utils
import Test.Validity.Utils

-- | Standard test spec for properties of Hashable instances for valid values
--
-- Example usage:
--
-- > hashableSpec @Int
hashableSpec ::
  forall a.
  (Show a, Eq a, Typeable a, GenValid a, Hashable a) =>
  Spec
hashableSpec = hashableSpecOnGen @a genValid "valid" shrinkValid

-- | 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) =>
  Spec
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 ->
  (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 ->
  (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) ->
                  forAllValid $ \int ->
                    when (a1 == a2) $
                      let h = hashWithSalt int
                       in h a1 `shouldBe` h a2