content: HUnitBase.lhs  --  basic definitions
  
  $Id: HUnitBase.lhs,v 1.12 2002/02/14 19:31:57 heringto Exp $
  
  > module HUnitBase
  > (
  >   {- from HUnitLang: -} Assertion, assertFailure,
  >   assertString, assertBool, assertEqual,
  >   Assertable(..), ListAssertable(..),
  >   AssertionPredicate, AssertionPredicable(..),
  >   (@?), (@=?), (@?=),
  >   Test(..), Node(..), Path,
  >   testCaseCount,
  >   Testable(..),
  >   (~?), (~=?), (~?=), (~:),
  >   Counts(..), State(..),
  >   ReportStart, ReportProblem,
  >   testCasePaths,
  >   performTest
  > )
  > where
  
  > import Monad (unless, foldM)
  
  
  Assertion Definition
  ====================
  
  > import HUnitLang
  
  
  Conditional Assertion Functions
  -------------------------------
  
  > assertBool :: String -> Bool -> Assertion
  > assertBool msg b = unless b (assertFailure msg)
  
  > assertString :: String -> Assertion
  > assertString s = unless (null s) (assertFailure s)
  
  > assertEqual :: (Eq a, Show a) => String -> a -> a -> Assertion
  > assertEqual preface expected actual =
  >   unless (actual == expected) (assertFailure msg)
  >  where msg = (if null preface then "" else preface ++ "\n") ++
  >              "expected: " ++ show expected ++ "\n but got: " ++ show actual
  
  
  Overloaded `assert` Function
  ----------------------------
  
  > class Assertable t
  >  where assert :: t -> Assertion
  
  > instance Assertable ()
  >  where assert = return
  
  > instance Assertable Bool
  >  where assert = assertBool ""
  
  > instance (ListAssertable t) => Assertable [t]
  >  where assert = listAssert
  
  > instance (Assertable t) => Assertable (IO t)
  >  where assert = (>>= assert)
  
  We define the assertability of `[Char]` (that is, `String`) and leave
  other types of list to possible user extension.
  
  > class ListAssertable t
  >  where listAssert :: [t] -> Assertion
  
  > instance ListAssertable Char
  >  where listAssert = assertString
  
  
  Overloaded `assertionPredicate` Function
  ----------------------------------------
  
  > type AssertionPredicate = IO Bool
  
  > class AssertionPredicable t
  >  where assertionPredicate :: t -> AssertionPredicate
  
  > instance AssertionPredicable Bool
  >  where assertionPredicate = return
  
  > instance (AssertionPredicable t) => AssertionPredicable (IO t)
  >  where assertionPredicate = (>>= assertionPredicate)
  
  
  Assertion Construction Operators
  --------------------------------
  
  > infix  1 @?, @=?, @?=
  
  > (@?) :: (AssertionPredicable t) => t -> String -> Assertion
  > pred @? msg = assertionPredicate pred >>= assertBool msg
  
  > (@=?) :: (Eq a, Show a) => a -> a -> Assertion
  > expected @=? actual = assertEqual "" expected actual
  
  > (@?=) :: (Eq a, Show a) => a -> a -> Assertion
  > actual @?= expected = assertEqual "" expected actual
  
  
  
  Test Definition
  ===============
  
  > data Test = TestCase Assertion
  >           | TestList [Test]
  >           | TestLabel String Test
  
  > instance Show Test where
  >   showsPrec p (TestCase _)    = showString "TestCase _"
  >   showsPrec p (TestList ts)   = showString "TestList " . showList ts
  >   showsPrec p (TestLabel l t) = showString "TestLabel " . showString l
  >                                 . showChar ' ' . showsPrec p t
  
  > testCaseCount :: Test -> Int
  > testCaseCount (TestCase _)    = 1
  > testCaseCount (TestList ts)   = sum (map testCaseCount ts)
  > testCaseCount (TestLabel _ t) = testCaseCount t
  
  
  > data Node  = ListItem Int | Label String
  >   deriving (Eq, Show, Read)
  
  > type Path = [Node]    -- Node order is from test case to root.
  
  
  > testCasePaths :: Test -> [Path]
  > testCasePaths t = tcp t []
  >  where tcp (TestCase _) p = [p]
  >        tcp (TestList ts) p =
  >          concat [ tcp t (ListItem n : p) | (t,n) <- zip ts [0..] ]
  >        tcp (TestLabel l t) p = tcp t (Label l : p)
  
  
  Overloaded `test` Function
  --------------------------
  
  > class Testable t
  >  where test :: t -> Test
  
  > instance Testable Test
  >  where test = id
  
  > instance (Assertable t) => Testable (IO t)
  >  where test = TestCase . assert
  
  > instance (Testable t) => Testable [t]
  >  where test = TestList . map test
  
  
  Test Construction Operators
  ---------------------------
  
  > infix  1 ~?, ~=?, ~?=
  > infixr 0 ~:
  
  > (~?) :: (AssertionPredicable t) => t -> String -> Test
  > pred ~? msg = TestCase (pred @? msg)
  
  > (~=?) :: (Eq a, Show a) => a -> a -> Test
  > expected ~=? actual = TestCase (expected @=? actual)
  
  > (~?=) :: (Eq a, Show a) => a -> a -> Test
  > actual ~?= expected = TestCase (actual @?= expected)
  
  > (~:) :: (Testable t) => String -> t -> Test
  > label ~: t = TestLabel label (test t)
  
  
  
  Test Execution
  ==============
  
  > data Counts = Counts { cases, tried, errors, failures :: Int }
  >   deriving (Eq, Show, Read)
  
  > data State = State { path :: Path, counts :: Counts }
  >   deriving (Eq, Show, Read)
  
  > type ReportStart us = State -> us -> IO us
  
  > type ReportProblem us = String -> State -> us -> IO us
  
  
  Note that the counts in a start report do not include the test case
  being started, whereas the counts in a problem report do include the
  test case just finished.  The principle is that the counts are sampled
  only between test case executions.  As a result, the number of test
  case successes always equals the difference of test cases tried and
  the sum of test case errors and failures.
  
  
  > performTest :: ReportStart us -> ReportProblem us -> ReportProblem us
  >                  -> us -> Test -> IO (Counts, us)
  > performTest reportStart reportError reportFailure us t = do
  >   (ss', us') <- pt initState us t
  >   unless (null (path ss')) $ error "performTest: Final path is nonnull"
  >   return (counts ss', us')
  >  where
  >   initState  = State{ path = [], counts = initCounts }
  >   initCounts = Counts{ cases = testCaseCount t, tried = 0,
  >                        errors = 0, failures = 0}
  
  >   pt ss us (TestCase a) = do
  >     us' <- reportStart ss us
  >     r <- performTestCase a
  >     case r of Nothing         -> do return (ss', us')
  >               Just (True,  m) -> do usF <- reportFailure m ssF us'
  >                                     return (ssF, usF)
  >               Just (False, m) -> do usE <- reportError   m ssE us'
  >                                     return (ssE, usE)
  >    where c@Counts{ tried = t } = counts ss
  >          ss' = ss{ counts = c{ tried = t + 1 } }
  >          ssF = ss{ counts = c{ tried = t + 1, failures = failures c + 1 } }
  >          ssE = ss{ counts = c{ tried = t + 1, errors   = errors   c + 1 } }
  
  >   pt ss us (TestList ts) = foldM f (ss, us) (zip ts [0..])
  >    where f (ss, us) (t, n) = withNode (ListItem n) ss us t
  
  >   pt ss us (TestLabel label t) = withNode (Label label) ss us t
  
  >   withNode node ss0 us0 t = do (ss2, us1) <- pt ss1 us0 t
  >                                return (ss2{ path = path0 }, us1)
  >    where path0 = path ss0
  >          ss1 = ss0{ path = node : path0 }
  