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

-- | Hashable properties
--
-- You will need @TypeApplications@ to use these.
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

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

-- | Standard test spec for properties of Hashable instances for invalid values
--
-- Example usage:
--
-- > hashableSpecOnInvalid @Double
hashableSpecOnInvalid ::
       forall a. (Show a, Eq a, Typeable a, GenInvalid a, Hashable a)
    => Spec
hashableSpecOnInvalid = hashableSpecOnGen @a genInvalid "invalid" shrinkInvalid

-- | Standard test spec for properties of Hashable instances for unchecked values
--
-- Example usage:
--
-- > hashableSpec @Int
hashableSpec ::
       forall a. (Show a, Eq a, Typeable a, GenUnchecked a, Hashable a)
    => Spec
hashableSpec = hashableSpecOnGen @a genUnchecked "unchecked" shrinkUnchecked

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