{-# LANGUAGE CPP              #-}
{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Test.QuickCheck.Instances.Hashable () where

import Prelude ()
import Test.QuickCheck.Instances.CustomPrelude

import Data.Hashable (Hashable, Hashed, hashed)

import Test.QuickCheck

-------------------------------------------------------------------------------
-- hashable
-------------------------------------------------------------------------------

#if MIN_VERSION_hashable(1,2,5)
instance (Hashable a, Arbitrary a) => Arbitrary (Hashed a) where
    arbitrary :: Gen (Hashed a)
arbitrary = a -> Hashed a
forall a. Hashable a => a -> Hashed a
hashed (a -> Hashed a) -> Gen a -> Gen (Hashed a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
forall a. Arbitrary a => Gen a
arbitrary

instance CoArbitrary (Hashed a) where
    coarbitrary :: Hashed a -> Gen b -> Gen b
coarbitrary Hashed a
x = Hashed (Hashed a) -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary (Hashed a -> Hashed (Hashed a)
forall a. Hashable a => a -> Hashed a
hashed Hashed a
x)
#endif