My Test Utility Module

OutPuts

RGB data: #ff0033:
  it should get RED value  : [OK]
  it should get GREEN value: [OK]
  it should get BLUE value : [OK]
\rgb -> red rgb:
  λ (RGB 256 0 51) -> 256 : [OK]
  λ (RGB 85 0 68)  -> 85  : [OK]

        Properties  Test Cases   Total
Passed  0           5            5
Failed  0           0            0
Total   0           5            5

RGB.hs

module RGB where

data RGB = RGB { red :: Int, green :: Int, blue :: Int } deriving (Eq, Show)

SampleTest.hs

import Test.Framework ( defaultMain, Test )
import TestUtil
import RGB

main :: IO ()
main = defaultMain testSuite

testSuite :: [Test]
testSuite =
  [ subject "RGB data: #ff0033" (RGB 0xff 0x00 0x33)
    [ "it should get RED value" +: 0xff <=? red
    , "it should get GREEN value" +: 0x00 <=? green
    , "it should get BLUE value" +: 0x33 <=? blure
    ]
  , subject "\\rgb -> red rgb" red
    [ 0xff <-? (RGB 0xff 0x00 0x33)
    , 0x55 <-? (RGB 0x55 0x00 0x44)
    ]
  ]

TestUtil.hs

module TestUtil (
  subject, should,
  (<-?), (<=?), (+:), (-:), (*:), (%:), (/:)
 ) where

import Test.Framework ( testGroup, Test, TestName )
import Test.Framework.Providers.HUnit ( testCase )
import Test.Framework.Providers.QuickCheck2 ( testProperty )
import Test.HUnit ( (@=?), Assertion )
import Test.QuickCheck ( Testable )

infixr 5 +:, -:, *:, %:, /:
infixr 6 <-?, <=?

subject :: TestName       -- test label
           -> a           -- subject function
           -> [a -> Test] -- tests about subject
           -> Test
subject label target = testGroup label . map ($ target)

should :: TestName                 -- test label
          -> t                     -- expected value
          -> (t -> b -> Assertion) -- test assertion operator
          -> (a -> b)              -- function return actual value
          -> a                     -- subject
          -> Test
should label expected op fn = testCase label . op expected . fn

(<-?) :: (Show a, Show b, Eq b) =>
          b           -- expected value
          -> a        -- argument for subject function
          -> (a -> b) -- subject function
          -> Test
expected <-? arg = testCase detail . ( expected @=? ) . ($ arg) where
  detail = unwords [ "λ", show arg, "\t->", show expected ++ "\t" ]

(<=?) :: (Show b, Eq b) =>
         b           -- expected value
         -> (a -> b) -- function return actual value
         -> a        -- argument for subject function
         -> Assertion
expected <=? fn = (expected @=?) . fn

(-:) :: TestName -> Assertion -> Test
n -: t  = testCase n t

(+:) :: TestName -> (a -> Assertion) -> a -> Test
n +: f  = testCase n . f

(*:) :: Testable a => TestName -> a -> Test
n *: p  = testProperty n p

(%:) :: Testable b => TestName -> (a -> b) -> a -> Test
n %: f  = testProperty n . f

(/:) :: TestName -> [Test] -> Test
l /: ts = testGroup l ts