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

  This testing requires an 'Eq' instance, which not all 'Functor's
  actually have. It also requires a 'Show' instance, which is also
  uncommon. The 'Label1' wrapper may be useful in dealing with the
  'Show' requirement.

  Tests are supplied both in regular \"unlabelled\" form, and also
  in a special \"labelled\" form, where function objects have
  'Label's attached to them. Because of this, the function used for
  each test can be recorded in the test log, which can be quite
  helpful.
-}

module Test.AC.Class.Functor where

import Test.AC.Test
import Test.AC.Label

-- * Unlabelled tests

-- | Check that @'fmap' 'id' '==' 'id'@.
p_map_id :: (Functor f, Eq (f x), Show (f x)) => f x -> Test
p_map_id fx =
  title "fmap id == id" $
  argument "fx" fx $
  fmap id fx ?= fx

-- | Check that @'fmap' (f '.' g) '==' 'fmap' 'f' '.' 'fmap' g@.
p_map_compose :: (Functor f, Eq (f z), Show (f x), Show (f y), Show (f z)) => f x -> (x -> y) -> (y -> z) -> Test
p_map_compose fx g f =
  title "fmap (f . g) == fmap f . fmap g" $
  argument "fx" fx $
  temporary "fmap g fx" (fmap g fx) $
  temporary "fmap f (fmap g fx)" (fmap f (fmap g fx)) $
  fmap (f . g) fx ?= fmap f (fmap g fx)

{- |
  Given a list of /distinct/ 'Functor' values and functions, perform
  all tests on all combinations of inputs. (If the inputs are not
  distinct, some redundant tests will be performed.)

  The argument types are somewhat constrained to keep the type
  signature reasonably simple.
-}
p_Functor :: (Functor f, Eq (f x), Show (f x)) => [f x] -> [x -> x] -> Test
p_Functor fxs fs =
  title "p_Functor" $
  argument "fxs" fxs $
  tests
  [
    title "p_map_id"      $ tests [ p_map_id      fx       | fx <- fxs                     ],
    title "p_map_compose" $ tests [ p_map_compose fx f2 f1 | fx <- fxs, f1 <- fs, f2 <- fs ]
  ]

-- * Labelled tests

-- | Check that @'fmap' (f '.' g) '==' 'fmap' 'f' '.' 'fmap' g@.
p_map_compose_L :: (Functor f, Eq (f z), Show (f x), Show (f y), Show (f z)) => f x -> Label (x -> y) -> Label (y -> z) -> Test
p_map_compose_L fx (Label lg g) (Label lf f) =
  title "fmap (f . g) == fmap f . fmap g" $
  argument "fx" fx $
  argument_ "f" lf $
  argument_ "g" lg $
  temporary "fmap g fx" (fmap g fx) $
  temporary "fmap f (fmap g fx)" (fmap f (fmap g fx)) $
  fmap (f . g) fx ?= fmap f (fmap g fx)

{- |
  Given a list of /distinct/ 'Functor' values and functions, perform
  all tests on all combinations of inputs. (If the inputs are not
  distinct, some redundant tests will be performed.)

  The argument types are somewhat constrained to keep the function's
  type signature reasonably simple.
-}
p_Functor_L :: (Functor f, Eq (f x), Show (f x)) => [f x] -> [Label (x -> x)] -> Test
p_Functor_L fxs fs =
  title "p_Functor_L" $
  argument "fxs" fxs $
  tests
  [
    title "p_map_id"        $ tests [ p_map_id        fx       | fx <- fxs                     ],
    title "p_map_compose_L" $ tests [ p_map_compose_L fx f2 f1 | fx <- fxs, f1 <- fs, f2 <- fs ]
  ]