{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

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

import Control.Monad
import Data.Data
import Data.GenValidity
import Data.Hashable
import Test.QuickCheck
import Test.Syd
import Test.Syd.Validity.Property.Utils
import Test.Syd.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 :: forall a.
(Show a, Eq a, Typeable a, GenValid a, Hashable a) =>
Spec
hashableSpec = forall a.
(Show a, Eq a, Typeable a, Hashable a) =>
Gen a -> String -> (a -> [a]) -> Spec
hashableSpecOnGen @a forall a. GenValid a => Gen a
genValid String
"valid" 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 :: forall a.
(Show a, Eq a, Typeable a, Arbitrary a, Hashable a) =>
Spec
hashableSpecOnArbitrary = forall a.
(Show a, Eq a, Typeable a, Hashable a) =>
Gen a -> String -> (a -> [a]) -> Spec
hashableSpecOnGen @a forall a. Arbitrary a => Gen a
arbitrary String
"arbitrary" 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 :: forall a.
(Show a, Eq a, Typeable a, Hashable a) =>
Gen a -> String -> (a -> [a]) -> Spec
hashableSpecOnGen Gen a
gen = forall a.
(Show a, Eq a, Typeable a, Hashable a) =>
Gen (a, a) -> String -> (a -> [a]) -> Spec
checkGen forall a b. (a -> b) -> a -> b
$ (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
gen 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 :: forall a.
(Show a, Eq a, Typeable a, Hashable a) =>
Gen (a, a) -> String -> (a -> [a]) -> Spec
checkGen Gen (a, a)
gen String
genname a -> [a]
s =
  forall (a :: [*]) b c. TestDefM a b c -> TestDefM a b c
parallel forall a b. (a -> b) -> a -> b
$ do
    let name :: String
name = forall {k} (a :: k). Typeable a => String
nameOf @a
        hashablestr :: String
hashablestr = [String] -> String
unwords [String
"hashWithSalt :: Int ->", String
name, String
"-> Int"]
    forall (outers :: [*]) inner.
String -> TestDefM outers inner () -> TestDefM outers inner ()
describe (String
"Hashable " forall a. [a] -> [a] -> [a]
++ String
name)
      forall a b. (a -> b) -> a -> b
$ forall (outers :: [*]) inner.
String -> TestDefM outers inner () -> TestDefM outers inner ()
describe String
hashablestr
      forall a b. (a -> b) -> a -> b
$ forall (outers :: [*]) inner test.
(HasCallStack, IsTest test, Arg1 test ~ (), Arg2 test ~ inner) =>
String -> test -> TestDefM outers inner ()
it
        ( [String] -> String
unwords
            [ String
"satisfies (a == b) => (hashWithSalt n a) ==",
              String
"(hashWithSalt n b), for every n and for",
              String
genname,
              String
name
            ]
        )
      forall a b. (a -> b) -> a -> b
$ let ss :: (a, a) -> [(a, a)]
ss (a
a, a
b) = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> [a]
s a
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> [a]
s a
b
         in forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
forAllShrink Gen (a, a)
gen (a, a) -> [(a, a)]
ss forall a b. (a -> b) -> a -> b
$ \(a
a1, a
a2) ->
              forall a prop.
(Show a, GenValid a, Testable prop) =>
(a -> prop) -> Property
forAllValid forall a b. (a -> b) -> a -> b
$ \Int
int ->
                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a
a1 forall a. Eq a => a -> a -> Bool
== a
a2) forall a b. (a -> b) -> a -> b
$
                  let h :: a -> Int
h = forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
int
                   in a -> Int
h a
a1 forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` a -> Int
h a
a2