{-# 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 :: Spec
hashableSpec = Gen a -> String -> (a -> [a]) -> Spec
forall a.
(Show a, Eq a, Typeable a, Hashable a) =>
Gen a -> String -> (a -> [a]) -> Spec
hashableSpecOnGen @a Gen a
forall a. GenValid a => Gen a
genValid String
"valid" a -> [a]
forall a. GenValid a => a -> [a]
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 :: Spec
hashableSpecOnArbitrary = Gen a -> String -> (a -> [a]) -> Spec
forall a.
(Show a, Eq a, Typeable a, Hashable a) =>
Gen a -> String -> (a -> [a]) -> Spec
hashableSpecOnGen @a Gen a
forall a. Arbitrary a => Gen a
arbitrary String
"arbitrary" a -> [a]
forall a. Arbitrary a => a -> [a]
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 a -> String -> (a -> [a]) -> Spec
hashableSpecOnGen Gen a
gen = Gen (a, a) -> String -> (a -> [a]) -> Spec
forall a.
(Show a, Eq a, Typeable a, Hashable a) =>
Gen (a, a) -> String -> (a -> [a]) -> Spec
checkGen (Gen (a, a) -> String -> (a -> [a]) -> Spec)
-> Gen (a, a) -> String -> (a -> [a]) -> Spec
forall a b. (a -> b) -> a -> b
$ (,) (a -> a -> (a, a)) -> Gen a -> Gen (a -> (a, a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
gen Gen (a -> (a, a)) -> Gen a -> Gen (a, a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen a
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 (a, a) -> String -> (a -> [a]) -> Spec
checkGen Gen (a, a)
gen String
genname a -> [a]
s =
  Spec -> Spec
forall a. SpecWith a -> SpecWith a
parallel (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    let name :: String
name = Typeable a => String
forall k (a :: k). Typeable a => String
nameOf @a
        hashablestr :: String
hashablestr = [String] -> String
unwords [String
"hashWithSalt :: Int ->", String
name, String
"-> Int"]
    String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (String
"Hashable " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name) (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$
      String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
hashablestr (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$
        String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it
          ( [String] -> String
unwords
              [ String
"satisfies (a == b) => (hashWithSalt n a) ==",
                String
"(hashWithSalt n b), for every n and for",
                String
genname,
                String
name
              ]
          )
          (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ let ss :: (a, a) -> [(a, a)]
ss (a
a, a
b) = (,) (a -> a -> (a, a)) -> [a] -> [a -> (a, a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> [a]
s a
a [a -> (a, a)] -> [a] -> [(a, a)]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> [a]
s a
b
             in Gen (a, a)
-> ((a, a) -> [(a, a)]) -> ((a, a) -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
forAllShrink Gen (a, a)
gen (a, a) -> [(a, a)]
ss (((a, a) -> Property) -> Property)
-> ((a, a) -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \(a
a1, a
a2) ->
                  (Int -> IO ()) -> Property
forall a prop.
(Show a, GenValid a, Testable prop) =>
(a -> prop) -> Property
forAllValid ((Int -> IO ()) -> Property) -> (Int -> IO ()) -> Property
forall a b. (a -> b) -> a -> b
$ \Int
int ->
                    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a
a1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a2) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                      let h :: a -> Int
h = Int -> a -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
int
                       in a -> Int
h a
a1 Int -> Int -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` a -> Int
h a
a2