Ord.hs

{- |
  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          ]
  ]