```{- |
Properties for testing that instances of the 'Ord' class perform
correctly.

'p_symmetric' and 'p_transitive' check the basic properties of the
ordering. In other words, they test the 'compare' method. 'p_equal'
checks that 'Ord' agrees with 'Eq' (that is, 'compare' returns 'EQ'
when '==' returns 'True'). The "Test.AC.Class.Eq" module already
checks that 'Eq' is reflexive, so if 'Ord' agrees with 'Eq' then
'Ord' too is reflexive, and we don't need a seperate test for that.
The remaining tests (i.e., 'p_compare', 'p_min' and 'p_max') check
for the extraordinarily unlikely case that the various 'Ord'
methods do not agree with each other. (Usually they are implemented
in terms of each other.)
-}

module Test.AC.Class.Ord where

import Test.AC.Test

-- | Check that 'compare' agrees with '==' on equity.
p_equal :: (Show x, Ord x) => x -> x -> Test
p_equal x y =
title "compare agrees with (==)" \$
argument "x" x \$
argument "y" y \$
temporary "x == y" (x == y) \$
temporary "compare x y" (compare x y) \$
if x == y
then compare x y ?=  EQ
else compare x y ?/= EQ

-- | Check that swapping the arguments to 'compare' works correctly.
p_symmetric :: (Show x, Ord x) => x -> x -> Test
p_symmetric x y =
title "if x < y then y > x" \$
argument "x" x \$
argument "y" y \$
temporary "compare x y" (compare x y) \$
case compare x y of
EQ -> compare y x ?= EQ
LT -> compare y x ?= GT
GT -> compare y x ?= LT

-- | Check that if @x \< y@ and @y \< z@ then @x \< z@.
p_transitive :: (Show x, Ord x) => x -> x -> x -> Test
p_transitive x y z =
title "if x < y and y < z then x < z" \$
argument "x" x \$
argument "y" y \$
argument "z" z \$
temporary "compare x y" (compare x y) \$
temporary "compare y z" (compare y z) \$
case (compare x y, compare y z) of
(EQ, c ) -> compare x z ?= c
(c , EQ) -> compare x z ?= c
(c1, c2) -> if c1 == c2 then compare x z ?= c1 else inapplicable

-- | Check that 'compare' agrees with '>', '<', etc.
p_compare :: (Show x, Ord x) => x -> x -> Test
p_compare x y =
title "compare x y agrees with (<), (>), etc." \$
argument "x" x \$
argument "y" y \$
temporary "compare x y" (compare x y) \$
let
(b1, b2, b3, b4) =
case compare x y of
LT -> (True , True , False, False)
EQ -> (False, True , False, True )
GT -> (False, False, True , True )
in
tests
[
title "x <  y" \$ (x <  y) ?= b1,
title "x <= y" \$ (x <= y) ?= b2,
title "x >  y" \$ (x >  y) ?= b3,
title "x >= y" \$ (x >= y) ?= b4
]

-- | Check that 'min' works correctly.
p_min :: (Show x, Ord x) => x -> x -> Test
p_min x y =
title "min x y" \$
argument "x" x \$
argument "y" y \$
temporary "compare x y" (compare x y) \$
case compare x y of
EQ -> tests [title "min x y == x" \$ min x y ?= x, title "min x y == y" \$ min x y ?= y]
LT -> min x y ?= x
GT -> min x y ?= y

-- | Check that 'max' works correctly.
p_max :: (Show x, Ord x) => x -> x -> Test
p_max x y =
title "max x y" \$
argument "x" x \$
argument "y" y \$
temporary "compare x y" (compare x y) \$
case compare x y of
EQ -> tests [title "max x y == x" \$ max x y ?= x, title "max x y == y" \$ max x y ?= y]
LT -> max x y ?= y
GT -> max x y ?= x

{- |
Given a list of /distinct/ values, perform all applicable tests
on all possible combinations of inputs. (If the inputs are not
distinct, some redundant tests are performed.)
-}
p_Ord :: (Show x, Ord x) => [x] -> Test
p_Ord xs =
title "p_Eq" \$
argument "xs" xs \$
tests
[
title "p_equal"      \$ tests [ p_equal      x y   | x <- xs, y <- xs          ],
title "p_symmetric"  \$ tests [ p_symmetric  x y   | x <- xs, y <- xs          ],
title "p_transitive" \$ tests [ p_transitive x y z | x <- xs, y <- xs, z <- xs ],
title "p_compare"    \$ tests [ p_compare    x y   | x <- xs, y <- xs          ],
title "p_min"        \$ tests [ p_min        x y   | x <- xs, y <- xs          ],
title "p_max"        \$ tests [ p_max        x y   | x <- xs, y <- xs          ]
]
```