{-# LANGUAGE TypeFamilies      #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE FlexibleInstances #-}
-- | 
--
-- This library provide set of generic properties for laws of standard
-- type classes and limited way to compose them. Here are some
-- examples:
--
-- Testing monoid laws
--
-- >>> quickCheck $ eq $ prop_Monoid (T :: T [Int])
-- +++ OK, passed 100 tests.
-- >>> quickCheck $ eq $ prop_Monoid (T :: T (Maybe [Int]))
-- +++ OK, passed 100 tests.
-- 
-- Testing functor laws
--
-- >>> quickCheck $ eq $ prop_FunctorCompose (+2) (+199) (T :: T [Int])
-- +++ OK, passed 100 tests.
--
-- /Fixing type/
--
-- All properties in this library are polymorphic. For example
-- property for checking associativity of 'mappend' could have
-- following type:
--
-- > prop_mappend :: (Eq a, Monoid a) => a -> a -> a -> Bool
--
-- But if one tries to pass this expression to 'quickCheck' GHC will
-- rightfully complain that type is too generic. Indeed there is no
-- way to figure out what is type of a. Obvious way to fix type of @a@
-- is to add type signature. However it's too cumbersome to write
-- signature for 3 parameter function. 
--
-- Another approach was taken instead. All properties take dummy
-- parameter which fix type:
--
-- > prop_Mappend :: (Eq a, Monoid a) => T a -> a -> a -> a -> Bool
--
-- 'T' is phanom typed unit. It ensures that only type information
-- could be passed to function. For example test invokation could look
-- like this:
--
-- > quickCheck $ prop_Mappend (T :: T [Int])
--
-- By convention all user supplied parameters are placed before T and
-- all quickcheck supplied parameters are after T.
--
-- /Comparing for equality/
--
-- A lot of QuickCheck properties have form @expression = another
-- expression@. It's natural to compare them for equality however not
-- all types have 'Eq' instance. Functions are most prominent example.
--
-- There are three generic ways to compare values for equality.
--
--  (1) Use '==' operator
--
--  2. Convert value to some type with Eq instance and compare
--     them. Caller must ensure that such conversion make sence
--
--  3. Most generic: use custom comparison function.
--
-- Functions 'eq', 'eqOn' and 'eqWith' transform property with delayed
-- comparison of equality to one which could be tested with quickCheck.
--
-- This approach naturally generelizes to arbitrary boolean
-- expressions of properties with this form. 
--
-- Delaying of comparison and composition of properties is implemented
-- using 'Equal' data type and 'Equalable' type class.
module Test.QuickCheck.Property.Common (
    -- * Convert to QuickCheck properies
    eq
  , eqOn
  , eqWith
    -- * Compose properties
  , (.==.)
  , (.&&.)
  , (.||.)
  , notE
    -- * Utils
  , T(..)
  ) where

import Data.Function (on)
import Test.QuickCheck.Property.Common.Internal

-- | Convenience sinonym for 'Equal'. Delay comparison for equality
(.==.) :: a -> a -> Equal a
(.==.) = Equal

-- | Both properties are true.
(.&&.) :: Equalable a => a -> a -> a
(.&&.) = zipEquals AndE

-- | One of properties is true
(.||.) :: Equalable a => a -> a -> a
(.||.) = zipEquals OrE

-- | Property is false
notE :: Equalable a => a -> a
notE = mapEqual NotE

-- | Compare values using @==@ 
eq :: (Equalable a, Eq (Result a)) => a -> Compared a
eq = equalWith (==)

-- | Convert values to types which could be compare
eqOn :: (Equalable a, Eq b) => (Result a -> b) -> a -> Compared a
eqOn f = equalWith ((==) `on` f)

-- | Compare with custom function. Just a shorter sinonym for equalWith
eqWith :: (Equalable a) => (Result a -> Result a -> Bool) -> a -> Compared a
eqWith = equalWith


-- | Data type is used to fix concrete data in properties
data T a = T