{-# LANGUAGE GADTs #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeOperators #-} module Cases( bool, maybe', either', op, gadtOp ) where import Test.HUnit import Data.Derive.IsDataCon makeIsDataCon ''Bool bool :: Test bool = TestList [ TestCase (assertEqual "is False False" (isFalse False) True) , TestCase (assertEqual "is True True" (isTrue True) True) , TestCase (assertEqual "is False not True" (isFalse True) False) , TestCase (assertEqual "is True not False" (isTrue False) False) ] makeIsDataCon ''Maybe maybe' :: Test maybe' = TestList [ TestCase (assertEqual "Nothing is Nothing" (isNothing Nothing) True) , TestCase (assertEqual "Nothing is Nothing" (isJust (Just ())) True) , TestCase (assertEqual "Nothing is not Just" (isNothing (Just ())) False) , TestCase (assertEqual "Just is not Nothing" (isJust Nothing) False)] makeIsDataCon ''Either either' :: Test either' = TestList [ TestCase (assertEqual "Left is Left" (isLeft (Left ())) True) , TestCase (assertEqual "Right is Right" (isRight (Right ())) True) , TestCase (assertEqual "Left is not Right" (isLeft (Right ())) False) , TestCase (assertEqual "Right is not Left" (isRight (Left ())) False)] data (:-:) a b = (:-:) a b | (:=) a b makeIsDataCon ''(:-:) op :: Test op = TestList [ TestCase (assertEqual "isColonMinusColon is isColonMinusColon" (isColonMinusColon ((:-:) () ())) True) , TestCase (assertEqual "isColonEqual is isColonEqual" (isColonEqual ( () := ())) True) , TestCase (assertEqual "isColonMinusColon is not isColonEqual" (isColonMinusColon ((:=) () ())) False) , TestCase (assertEqual "isColonEqual is not isColonMinusColon" (isColonEqual (() :-: ())) False)] data Gadt a b where (:*:), (:=:) :: a -> b -> Gadt a b makeIsDataCon ''Gadt gadtOp :: Test gadtOp = TestList [ TestCase (assertEqual "isColonStarColon is isColonStarColon" (isColonStarColon ((:*:) () ())) True) , TestCase (assertEqual "isColonEqualColon is isColonEqualColon" (isColonEqualColon ( () :=: ())) True) , TestCase (assertEqual "isColonStarColon is not isColonEqual" (isColonStarColon ((:=:) () ())) False) , TestCase (assertEqual "isColonEqualColon is not isColonStarColon" (isColonEqualColon (() :*: ())) False)]