Wrap.hs

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
-- $Header: c:/Source/Haskell/Wrapper/Data/Flex/SmallCheck/RCS/Wrap.hs,v 1.2 2010/03/13 00:11:09 dosuser Exp dosuser $
module Data.Flex.SmallCheck.Wrap where

import Test.SmallCheck

{-
import Control.Applicative ((<$>))

import Data.Wrap (result, argument)
-}

import Data.Type.Apply (Apply(..))
import Data.Type.Eq (TypeCast)
import Data.Type.TList ((:*:), TNil)

import Data.Flex.Wrap

{-
import Data.Flex.SmallCheck.Instances
-}

data X = X

prop_default_Eq_is_Eq x y = (x == y) == (w x == w y) where
    w = fWrap X :: Bool -> FW (X :*: TNil) Bool
    types = x :: Bool

data FWEqFirst = FWEqFirst

instance TypeCast r FWEqFirst => FWEq (FW (FWEqFirst :*: s) a) r

instance Eq a =>
    Apply (FWEquals t (a, b)) FWEqFirst (FW t (a, b) -> FW t (a, b) -> Bool)
  where
    apply _ _ = (==) `on` fst . unFlexiWrap

instance Eq a =>
    Apply (FWNotEquals t (a, b)) FWEqFirst (FW t (a, b) -> FW t (a, b) -> Bool)
  where
    apply _ _ = (/=) `on` fst `on` unFlexiWrap

prop_EqFirst_is_Eq_fst x y = (x `eqFst` y) == (w x == w y) where
    eqFst = (==) `on` fst
    w = FlexiWrap :: (Bool, Bool) -> FW (FWEqFirst :*: TNil) (Bool, Bool)

-- vim: expandtab:tabstop=4:shiftwidth=4