1{-# LANGUAGE ScopedTypeVariables #-}
2
3{-# OPTIONS_GHC -Wall #-}
4
5module Test.QuickCheck.Classes.Eq
6  ( eqLaws
7  ) where
8
9import Data.Proxy (Proxy)
10import Test.QuickCheck hiding ((.&.))
11import Test.QuickCheck.Property (Property)
12
13import Test.QuickCheck.Classes.Common (Laws(..))
14
15-- | Tests the following properties:
16--
17-- [/Transitive/]
18--   @a == b ∧ b == c ⇒ a == c@
19-- [/Symmetric/]
20--   @a == b ⇒ b == a@
21-- [/Reflexive/]
22--   @a == a@
23--
24-- Some of these properties involve implication. In the case that
25-- the left hand side of the implication arrow does not hold, we
26-- do not retry. Consequently, these properties only end up being
27-- useful when the data type has a small number of inhabitants.
28eqLaws :: (Eq a, Arbitrary a, Show a) => Proxy a -> Laws
29eqLaws p = Laws "Eq"
30  [ ("Transitive", eqTransitive p)
31  , ("Symmetric", eqSymmetric p)
32  , ("Reflexive", eqReflexive p)
33  ]
34
35eqTransitive :: forall a. (Show a, Eq a, Arbitrary a) => Proxy a -> Property
36eqTransitive _ = property $ \(a :: a) b c -> case a == b of
37  True -> case b == c of
38    True -> a == c
39    False -> a /= c
40  False -> case b == c of
41    True -> a /= c
42    False -> True
43
44eqSymmetric :: forall a. (Show a, Eq a, Arbitrary a) => Proxy a -> Property
45eqSymmetric _ = property $ \(a :: a) b -> case a == b of
46  True -> b == a
47  False -> b /= a
48
49eqReflexive :: forall a. (Show a, Eq a, Arbitrary a) => Proxy a -> Property
50eqReflexive _ = property $ \(a :: a) -> a == a
51