Internal.hs

{-# LANGUAGE TypeFamilies      #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE FlexibleInstances #-}
-- | Implementation of delayed comparison and composition of
--   properties
module Test.QuickCheck.Property.Common.Internal (
    -- * Comparison for equality
    Equal(..)
  , runEqual
  , Equalable(..)
  ) where



-- | Values to be compared for equality
data Equal a = Equal a a
             | NotE (Equal a)
             | AndE (Equal a) (Equal a)
             | OrE  (Equal a) (Equal a)

-- | Evaluate boolean expression inside 'Equal'
runEqual :: (a -> a -> Bool) -> Equal a -> Bool
runEqual f (Equal a b) = f a b
runEqual f (NotE e)    = not $ runEqual f e
runEqual f (AndE e g)  = runEqual f e && runEqual f g
runEqual f (OrE  e g)  = runEqual f e && runEqual f g



-- | Recurse through function to apply comparison to 'Equal'.
class Equalable a where
  -- | Type which should be compared for equality
  type Result a :: *
  -- | Result of comparison. Could be passed to 'quickCheck'
  type Compared a :: *
  -- | Compare value using custom comparison function
  equalWith :: (Result a -> Result a -> Bool) -> a -> Compared a
  -- | Map property 
  mapEqual  :: (Equal (Result a) -> Equal (Result a)) -> a -> a
  -- | Zip properties
  zipEquals :: (Equal (Result a) -> Equal (Result a) -> Equal (Result a)) -> a -> a -> a

instance Equalable (Equal a) where
  type Result   (Equal a) = a
  type Compared (Equal a) = Bool
  equalWith = runEqual
  mapEqual  = id
  zipEquals = id

instance Equalable a => Equalable (x -> a) where
  type Result   (x -> a) = Result a
  type Compared (x -> a) = x -> Compared a
  equalWith f fun = equalWith f . fun
  mapEqual  f fun = mapEqual  f . fun
  zipEquals f fun1 fun2 = \x -> zipEquals f (fun1 x) (fun2 x)