{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
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
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
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
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
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