Ticket #1632: hunit-docs.patch

New patches:

[changed file extensions from .lhs to .hs
Leif Frenzel <leiffrenzel@googlemail.com>**20070717153017] {
move ./Test/HUnit.lhs ./Test/HUnit.hs
move ./Test/HUnit/Base.lhs ./Test/HUnit/Base.hs
move ./Test/HUnit/Lang.lhs ./Test/HUnit/Lang.hs
move ./Test/HUnit/Terminal.lhs ./Test/HUnit/Terminal.hs
move ./Test/HUnit/Text.lhs ./Test/HUnit/Text.hs
}

[un-literated code
Leif Frenzel <leiffrenzel@googlemail.com>**20070717154325] {
hunk ./Test/HUnit.hs 1
-HUnit.lhs  --  interface module for HUnit
-
-> module Test.HUnit
-> (
->   module Test.HUnit.Base,
->   module Test.HUnit.Text
-> )
-> where
-
-> import Test.HUnit.Base
-> import Test.HUnit.Text
+-- interface module for HUnit
+
+module Test.HUnit
+(
+  module Test.HUnit.Base,
+  module Test.HUnit.Text
+)
+where
+
+import Test.HUnit.Base
+import Test.HUnit.Text
hunk ./Test/HUnit/Base.hs 1
-HUnitBase.lhs  --  basic definitions
-
-> module Test.HUnit.Base
-> (
->   {- from Test.HUnit.Lang: -} Assertion, assertFailure,
->   assertString, assertBool, assertEqual,
->   Assertable(..), ListAssertable(..),
->   AssertionPredicate, AssertionPredicable(..),
->   (@?), (@=?), (@?=),
->   Test(..), Node(..), Path,
->   testCaseCount,
->   Testable(..),
->   (~?), (~=?), (~?=), (~:),
->   Counts(..), State(..),
->   ReportStart, ReportProblem,
->   testCasePaths,
->   performTest
-> )
-> where
-
-> import Control.Monad (unless, foldM)
-
-
-Assertion Definition
-====================
-
-> import Test.HUnit.Lang
-
-
-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 }
+-- basic definitions
+
+module Test.HUnit.Base
+(
+  {- from Test.HUnit.Lang: -} Assertion, assertFailure,
+  assertString, assertBool, assertEqual,
+  Assertable(..), ListAssertable(..),
+  AssertionPredicate, AssertionPredicable(..),
+  (@?), (@=?), (@?=),
+  Test(..), Node(..), Path,
+  testCaseCount,
+  Testable(..),
+  (~?), (~=?), (~?=), (~:),
+  Counts(..), State(..),
+  ReportStart, ReportProblem,
+  testCasePaths,
+  performTest
+)
+where
+
+import Control.Monad (unless, foldM)
+
+
+-- Assertion Definition
+-- ====================
+
+import Test.HUnit.Lang
+
+
+-- 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 }
hunk ./Test/HUnit/Lang.hs 1
-Test/HUnit/Lang.lhs  --  HUnit language support.
-
-> module Test.HUnit.Lang
-> (
->   Assertion,
->   assertFailure,
->   performTestCase
-> )
-> where
-
-
-When adapting this module for other Haskell language systems, change
-the imports and the implementations but not the interfaces.
-
-
-
-Imports
--------
-
-> import Data.List (isPrefixOf)
-#if defined(__GLASGOW_HASKELL__) || defined(__HUGS__)
-> import Data.Dynamic
-> import Control.Exception as E         ( throwDyn, try, Exception(..) )
-#else
-> import System.IO.Error (ioeGetErrorString, try)
-#endif
-
-
-
-Interfaces
-----------
-
-An assertion is an `IO` computation with trivial result.
-
-> type Assertion = IO ()
-
-`assertFailure` signals an assertion failure with a given message.
-
-> assertFailure :: String -> Assertion
-
-`performTestCase` performs a single test case.  The meaning of the
-result is as follows:
-  Nothing               test case success
-  Just (True,  msg)     test case failure with the given message
-  Just (False, msg)     test case error with the given message
-
-> performTestCase :: Assertion -> IO (Maybe (Bool, String))
-
-
-Implementations
----------------
-
-#if defined(__GLASGOW_HASKELL__) || defined(__HUGS__)
-> data HUnitFailure = HUnitFailure String
->
-> hunitFailureTc :: TyCon
-> hunitFailureTc = mkTyCon "HUnitFailure"
-> {-# NOINLINE hunitFailureTc #-}
-> 
-> instance Typeable HUnitFailure where
->     typeOf _ = mkTyConApp hunitFailureTc []
-
-> assertFailure msg = E.throwDyn (HUnitFailure msg)
-
-> performTestCase action = 
->     do r <- E.try action
->        case r of 
->          Right () -> return Nothing
->          Left e@(E.DynException dyn) -> 
->              case fromDynamic dyn of
->                Just (HUnitFailure msg) -> return $ Just (True, msg)
->                Nothing                 -> return $ Just (False, show e)
->          Left e -> return $ Just (False, show e)
-#else
-> hunitPrefix = "HUnit:"
-
-> nhc98Prefix = "I/O error (user-defined), call to function `userError':\n  "
-
-> assertFailure msg = ioError (userError (hunitPrefix ++ msg))
-
-> performTestCase action = do r <- try action
->                             case r of Right () -> return Nothing
->                                       Left  e  -> return (Just (decode e))
->  where
->   decode e = let s0 = ioeGetErrorString e
->                  (_, s1) = dropPrefix nhc98Prefix s0
->              in            dropPrefix hunitPrefix s1
->   dropPrefix pref str = if pref `isPrefixOf` str
->                           then (True, drop (length pref) str)
->                           else (False, str)
-#endif
+-- HUnit language support.
+
+module Test.HUnit.Lang
+(
+  Assertion,
+  assertFailure,
+  performTestCase
+)
+where
+
+
+-- When adapting this module for other Haskell language systems, change
+-- the imports and the implementations but not the interfaces.
+
+
+
+-- Imports
+-- -------
+
+import Data.List (isPrefixOf)
+#if defined(__GLASGOW_HASKELL__) || defined(__HUGS__)
+import Data.Dynamic
+import Control.Exception as E         ( throwDyn, try, Exception(..) )
+#else
+import System.IO.Error (ioeGetErrorString, try)
+#endif
+
+
+
+-- Interfaces
+-- ----------
+
+-- An assertion is an `IO` computation with trivial result.
+
+type Assertion = IO ()
+
+-- `assertFailure` signals an assertion failure with a given message.
+
+assertFailure :: String -> Assertion
+
+-- `performTestCase` performs a single test case.  The meaning of the
+-- result is as follows:
+--  Nothing               test case success
+--  Just (True,  msg)     test case failure with the given message
+--  Just (False, msg)     test case error with the given message
+
+performTestCase :: Assertion -> IO (Maybe (Bool, String))
+
+
+-- Implementations
+-- ---------------
+
+#if defined(__GLASGOW_HASKELL__) || defined(__HUGS__)
+data HUnitFailure = HUnitFailure String
+
+hunitFailureTc :: TyCon
+hunitFailureTc = mkTyCon "HUnitFailure"
+{-# NOINLINE hunitFailureTc #-}
+ 
+instance Typeable HUnitFailure where
+    typeOf _ = mkTyConApp hunitFailureTc []
+
+assertFailure msg = E.throwDyn (HUnitFailure msg)
+
+performTestCase action = 
+    do r <- E.try action
+       case r of 
+         Right () -> return Nothing
+         Left e@(E.DynException dyn) -> 
+             case fromDynamic dyn of
+               Just (HUnitFailure msg) -> return $ Just (True, msg)
+               Nothing                 -> return $ Just (False, show e)
+         Left e -> return $ Just (False, show e)
+#else
+hunitPrefix = "HUnit:"
+
+nhc98Prefix = "I/O error (user-defined), call to function `userError':\n  "
+
+assertFailure msg = ioError (userError (hunitPrefix ++ msg))
+
+performTestCase action = do r <- try action
+                            case r of Right () -> return Nothing
+                                      Left  e  -> return (Just (decode e))
+ where
+  decode e = let s0 = ioeGetErrorString e
+                 (_, s1) = dropPrefix nhc98Prefix s0
+             in            dropPrefix hunitPrefix s1
+  dropPrefix pref str = if pref `isPrefixOf` str
+                          then (True, drop (length pref) str)
+                          else (False, str)
+#endif
hunk ./Test/HUnit/Terminal.hs 1
-> module Test.HUnit.Terminal
-> (
->   terminalAppearance
-> )
-> where
-
-> import Data.Char (isPrint)
-
-
-Simplifies the input string by interpreting '\r' and '\b' characters
-specially so that the result string has the same final (or "terminal",
-pun intended) appearance as would the input string when written to a
-terminal that overwrites character positions following carriage
-returns and backspaces.
-
-The helper function `ta` takes an accumulating `ShowS`-style function
-that holds "committed" lines of text, a (reversed) list of characters
-on the current line *before* the cursor, a (normal) list of characters
-on the current line *after* the cursor, and the remaining input.
-
-> terminalAppearance :: String -> String
-> terminalAppearance str = ta id "" "" str
->  where
->   ta f bs as ('\n':cs) = ta (\t -> f (reverse bs ++ as ++ '\n' : t)) "" "" cs
->   ta f bs as ('\r':cs) = ta f "" (reverse bs ++ as) cs
->   ta f (b:bs) as ('\b':cs) = ta f bs (b:as) cs
->   ta f ""     as ('\b':cs) = error "'\\b' at beginning of line"
->   ta f bs as (c:cs) | not (isPrint c) = error "invalid nonprinting character"
->                     | null as   = ta f (c:bs) ""        cs
->                     | otherwise = ta f (c:bs) (tail as) cs
->   ta f bs as "" = f (reverse bs ++ as)
+module Test.HUnit.Terminal
+(
+  terminalAppearance
+)
+where
+
+import Data.Char (isPrint)
+
+
+-- Simplifies the input string by interpreting '\r' and '\b' characters
+-- specially so that the result string has the same final (or "terminal",
+-- pun intended) appearance as would the input string when written to a
+-- terminal that overwrites character positions following carriage
+-- returns and backspaces.
+
+-- The helper function `ta` takes an accumulating `ShowS`-style function
+-- that holds "committed" lines of text, a (reversed) list of characters
+-- on the current line *before* the cursor, a (normal) list of characters
+-- on the current line *after* the cursor, and the remaining input.
+
+terminalAppearance :: String -> String
+terminalAppearance str = ta id "" "" str
+ where
+  ta f bs as ('\n':cs) = ta (\t -> f (reverse bs ++ as ++ '\n' : t)) "" "" cs
+  ta f bs as ('\r':cs) = ta f "" (reverse bs ++ as) cs
+  ta f (b:bs) as ('\b':cs) = ta f bs (b:as) cs
+  ta f ""     as ('\b':cs) = error "'\\b' at beginning of line"
+  ta f bs as (c:cs) | not (isPrint c) = error "invalid nonprinting character"
+                    | null as   = ta f (c:bs) ""        cs
+                    | otherwise = ta f (c:bs) (tail as) cs
+  ta f bs as "" = f (reverse bs ++ as)
hunk ./Test/HUnit/Text.hs 1
-HUnitText.lhs  --  text-based test controller
-
-> module Test.HUnit.Text
-> (
->   PutText(..),
->   putTextToHandle, putTextToShowS,
->   runTestText,
->   showPath, showCounts,
->   runTestTT
-> )
-> where
-
-> import Test.HUnit.Base
-
-> import Control.Monad (when)
-> import System.IO (Handle, stderr, hPutStr, hPutStrLn)
-
-
-As the general text-based test controller (`runTestText`) executes a
-test, it reports each test case start, error, and failure by
-constructing a string and passing it to the function embodied in a
-`PutText`.  A report string is known as a "line", although it includes
-no line terminator; the function in a `PutText` is responsible for
-terminating lines appropriately.  Besides the line, the function
-receives a flag indicating the intended "persistence" of the line:
-`True` indicates that the line should be part of the final overall
-report; `False` indicates that the line merely indicates progress of
-the test execution.  Each progress line shows the current values of
-the cumulative test execution counts; a final, persistent line shows
-the final count values.
-
-The `PutText` function is also passed, and returns, an arbitrary state
-value (called `st` here).  The initial state value is given in the
-`PutText`; the final value is returned by `runTestText`.
-
-> data PutText st = PutText (String -> Bool -> st -> IO st) st
-
-
-Two reporting schemes are defined here.  `putTextToHandle` writes
-report lines to a given handle.  `putTextToShowS` accumulates
-persistent lines for return as a whole by `runTestText`.
-
-
-`putTextToHandle` writes persistent lines to the given handle,
-following each by a newline character.  In addition, if the given flag
-is `True`, it writes progress lines to the handle as well.  A progress
-line is written with no line termination, so that it can be
-overwritten by the next report line.  As overwriting involves writing
-carriage return and blank characters, its proper effect is usually
-only obtained on terminal devices.
-
-> putTextToHandle :: Handle -> Bool -> PutText Int
-> putTextToHandle handle showProgress = PutText put initCnt
->  where
->   initCnt = if showProgress then 0 else -1
->   put line pers (-1) = do when pers (hPutStrLn handle line); return (-1)
->   put line True  cnt = do hPutStrLn handle (erase cnt ++ line); return 0
->   put line False cnt = do hPutStr handle ('\r' : line); return (length line)
->     -- The "erasing" strategy with a single '\r' relies on the fact that the
->     -- lengths of successive summary lines are monotonically nondecreasing.
->   erase cnt = if cnt == 0 then "" else "\r" ++ replicate cnt ' ' ++ "\r"
-
-
-`putTextToShowS` accumulates persistent lines (dropping progess lines)
-for return by `runTestText`.  The accumulated lines are represented by
-a `ShowS` (`String -> String`) function whose first argument is the
-string to be appended to the accumulated report lines.
-
-> putTextToShowS :: PutText ShowS
-> putTextToShowS = PutText put id
->  where put line pers f = return (if pers then acc f line else f)
->        acc f line tail = f (line ++ '\n' : tail)
-
-
-`runTestText` executes a test, processing each report line according
-to the given reporting scheme.  The reporting scheme's state is
-threaded through calls to the reporting scheme's function and finally
-returned, along with final count values.
-
-> runTestText :: PutText st -> Test -> IO (Counts, st)
-> runTestText (PutText put us) t = do
->   (counts, us') <- performTest reportStart reportError reportFailure us t
->   us'' <- put (showCounts counts) True us'
->   return (counts, us'')
->  where
->   reportStart ss us = put (showCounts (counts ss)) False us
->   reportError   = reportProblem "Error:"   "Error in:   "
->   reportFailure = reportProblem "Failure:" "Failure in: "
->   reportProblem p0 p1 msg ss us = put line True us
->    where line  = "### " ++ kind ++ path' ++ '\n' : msg
->          kind  = if null path' then p0 else p1
->          path' = showPath (path ss)
-
-
-`showCounts` converts test execution counts to a string.
-
-> showCounts :: Counts -> String
-> showCounts Counts{ cases = cases, tried = tried,
->                    errors = errors, failures = failures } =
->   "Cases: " ++ show cases ++ "  Tried: " ++ show tried ++
->   "  Errors: " ++ show errors ++ "  Failures: " ++ show failures
-
-
-`showPath` converts a test case path to a string, separating adjacent
-elements by ':'.  An element of the path is quoted (as with `show`)
-when there is potential ambiguity.
-
-> showPath :: Path -> String
-> showPath [] = ""
-> showPath nodes = foldl1 f (map showNode nodes)
->  where f b a = a ++ ":" ++ b
->        showNode (ListItem n) = show n
->        showNode (Label label) = safe label (show label)
->        safe s ss = if ':' `elem` s || "\"" ++ s ++ "\"" /= ss then ss else s
-
-
-`runTestTT` provides the "standard" text-based test controller.
-Reporting is made to standard error, and progress reports are
-included.  For possible programmatic use, the final counts are
-returned.  The "TT" in the name suggests "Text-based reporting to the
-Terminal".
-
-> runTestTT :: Test -> IO Counts
-> runTestTT t = do (counts, 0) <- runTestText (putTextToHandle stderr True) t
->                  return counts
+-- text-based test controller
+
+module Test.HUnit.Text
+(
+  PutText(..),
+  putTextToHandle, putTextToShowS,
+  runTestText,
+  showPath, showCounts,
+  runTestTT
+)
+where
+
+import Test.HUnit.Base
+
+import Control.Monad (when)
+import System.IO (Handle, stderr, hPutStr, hPutStrLn)
+
+
+-- As the general text-based test controller (`runTestText`) executes a
+-- test, it reports each test case start, error, and failure by
+-- constructing a string and passing it to the function embodied in a
+-- `PutText`.  A report string is known as a "line", although it includes
+-- no line terminator; the function in a `PutText` is responsible for
+-- terminating lines appropriately.  Besides the line, the function
+-- receives a flag indicating the intended "persistence" of the line:
+-- `True` indicates that the line should be part of the final overall
+-- report; `False` indicates that the line merely indicates progress of
+-- the test execution.  Each progress line shows the current values of
+-- the cumulative test execution counts; a final, persistent line shows
+-- the final count values.
+
+-- The `PutText` function is also passed, and returns, an arbitrary state
+-- value (called `st` here).  The initial state value is given in the
+-- `PutText`; the final value is returned by `runTestText`.
+
+data PutText st = PutText (String -> Bool -> st -> IO st) st
+
+
+-- Two reporting schemes are defined here.  `putTextToHandle` writes
+-- report lines to a given handle.  `putTextToShowS` accumulates
+-- persistent lines for return as a whole by `runTestText`.
+
+
+-- `putTextToHandle` writes persistent lines to the given handle,
+-- following each by a newline character.  In addition, if the given flag
+-- is `True`, it writes progress lines to the handle as well.  A progress
+-- line is written with no line termination, so that it can be
+-- overwritten by the next report line.  As overwriting involves writing
+-- carriage return and blank characters, its proper effect is usually
+-- only obtained on terminal devices.
+
+putTextToHandle :: Handle -> Bool -> PutText Int
+putTextToHandle handle showProgress = PutText put initCnt
+ where
+  initCnt = if showProgress then 0 else -1
+  put line pers (-1) = do when pers (hPutStrLn handle line); return (-1)
+  put line True  cnt = do hPutStrLn handle (erase cnt ++ line); return 0
+  put line False cnt = do hPutStr handle ('\r' : line); return (length line)
+    -- The "erasing" strategy with a single '\r' relies on the fact that the
+    -- lengths of successive summary lines are monotonically nondecreasing.
+  erase cnt = if cnt == 0 then "" else "\r" ++ replicate cnt ' ' ++ "\r"
+
+
+-- `putTextToShowS` accumulates persistent lines (dropping progess lines)
+-- for return by `runTestText`.  The accumulated lines are represented by
+-- a `ShowS` (`String -> String`) function whose first argument is the
+-- string to be appended to the accumulated report lines.
+
+putTextToShowS :: PutText ShowS
+putTextToShowS = PutText put id
+ where put line pers f = return (if pers then acc f line else f)
+       acc f line tail = f (line ++ '\n' : tail)
+
+
+-- `runTestText` executes a test, processing each report line according
+-- to the given reporting scheme.  The reporting scheme's state is
+-- threaded through calls to the reporting scheme's function and finally
+-- returned, along with final count values.
+
+runTestText :: PutText st -> Test -> IO (Counts, st)
+runTestText (PutText put us) t = do
+  (counts, us') <- performTest reportStart reportError reportFailure us t
+  us'' <- put (showCounts counts) True us'
+  return (counts, us'')
+ where
+  reportStart ss us = put (showCounts (counts ss)) False us
+  reportError   = reportProblem "Error:"   "Error in:   "
+  reportFailure = reportProblem "Failure:" "Failure in: "
+  reportProblem p0 p1 msg ss us = put line True us
+   where line  = "### " ++ kind ++ path' ++ '\n' : msg
+         kind  = if null path' then p0 else p1
+         path' = showPath (path ss)
+
+
+-- `showCounts` converts test execution counts to a string.
+
+showCounts :: Counts -> String
+showCounts Counts{ cases = cases, tried = tried,
+                   errors = errors, failures = failures } =
+  "Cases: " ++ show cases ++ "  Tried: " ++ show tried ++
+  "  Errors: " ++ show errors ++ "  Failures: " ++ show failures
+
+
+-- `showPath` converts a test case path to a string, separating adjacent
+-- elements by ':'.  An element of the path is quoted (as with `show`)
+-- when there is potential ambiguity.
+
+showPath :: Path -> String
+showPath [] = ""
+showPath nodes = foldl1 f (map showNode nodes)
+ where f b a = a ++ ":" ++ b
+       showNode (ListItem n) = show n
+       showNode (Label label) = safe label (show label)
+       safe s ss = if ':' `elem` s || "\"" ++ s ++ "\"" /= ss then ss else s
+
+
+-- `runTestTT` provides the "standard" text-based test controller.
+-- Reporting is made to standard error, and progress reports are
+-- included.  For possible programmatic use, the final counts are
+-- returned.  The "TT" in the name suggests "Text-based reporting to the
+-- Terminal".
+
+runTestTT :: Test -> IO Counts
+runTestTT t = do (counts, 0) <- runTestText (putTextToHandle stderr True) t
+                 return counts
}

[converted existing source comments to Haddock comments and filled in rest of documentation
Leif Frenzel <leiffrenzel@googlemail.com>**20070823192207] {
hunk ./Test/HUnit.hs 1
--- interface module for HUnit
+-- | The HUnit library. To write HUnit tests it is sufficient to import this
+--   module, which simply re-exports all modules of the library.
hunk ./Test/HUnit/Base.hs 1
--- basic definitions
+-- | Basic definitions for the HUnit library.
+--
+--   This module contains what you need to create assertions and test cases and
+--   combine them into test suites. It also provides infrastructure for 
+--   implementing test controllers (which are used to execute tests). For an 
+--   exemplary implementation of a test controller, see "Test.HUnit.Text".
hunk ./Test/HUnit/Base.hs 10
-  {- from Test.HUnit.Lang: -} Assertion, assertFailure,
-  assertString, assertBool, assertEqual,
+  -- ** Declaring tests
+  Test(..),
+  (~=?), (~?=), (~:), (~?),
+  -- ** Making assertions
+  assertBool, assertEqual, assertString, 
+  {- from Test.HUnit.Lang: -}  
+  assertFailure, Assertion,
+  (@=?), (@?=), (@?),
+  -- ** Extending the assertion functionality
hunk ./Test/HUnit/Base.hs 21
-  (@?), (@=?), (@?=),
-  Test(..), Node(..), Path,
+  Node(..), Path,
hunk ./Test/HUnit/Base.hs 23
-  Testable(..),
-  (~?), (~=?), (~?=), (~:),
+  Testable(..),
+  -- ** Test execution
+  -- $testExecutionNote
hunk ./Test/HUnit/Base.hs 45
-assertBool :: String -> Bool -> Assertion
+-- | asserts that the specified condition holds.
+assertBool :: String    -- ^ a message that is displayed if the assertion fails
+           -> Bool      -- ^ the condition that is asserted to hold
+           -> Assertion
hunk ./Test/HUnit/Base.hs 51
-assertString :: String -> Assertion
+-- | signals an assertion failure if a non-empty message is passed.
+assertString :: String    -- ^ a message that is displayed with the assertion failure 
+             -> Assertion
hunk ./Test/HUnit/Base.hs 56
-assertEqual :: (Eq a, Show a) => String -> a -> a -> Assertion
+-- | asserts that the specified actual value is equal to the expected value.
+assertEqual :: (Eq a, Show a) => String -- ^ a message that is displayed if the assertion fails 
+                              -> a      -- ^ the expected value 
+                              -> a      -- ^ the actual value
+                              -> Assertion
hunk ./Test/HUnit/Base.hs 115
-(@?) :: (AssertionPredicable t) => t -> String -> Assertion
+-- | asserts that the condition obtained from the specified
+--   'AssertionPredicable' holds.
+(@?) :: (AssertionPredicable t) => t          -- ^ a value of which the asserted condition is predicated
+                                -> String     -- ^ a message that is displayed if the assertion fails
+                                -> Assertion
hunk ./Test/HUnit/Base.hs 121
-
-(@=?) :: (Eq a, Show a) => a -> a -> Assertion
-expected @=? actual = assertEqual "" expected actual
-
-(@?=) :: (Eq a, Show a) => a -> a -> Assertion
+
+-- | asserts that the specified actual value is equal to the expected value
+--   (with the expected value on the left-hand side).
+(@=?) :: (Eq a, Show a) => a -- ^ the expected value
+                        -> a -- ^ the actual value
+                        -> Assertion
+expected @=? actual = assertEqual "" expected actual
+
+-- | asserts that the specified actual value is equal to the expected value
+--   (with the actual value on the left-hand side).
+(@?=) :: (Eq a, Show a) => a -- ^ the actual value
+                        -> a -- ^ the expected value
+                        -> Assertion
hunk ./Test/HUnit/Base.hs 151
+-- | recursively counts all test cases contained in the specified test. 
hunk ./Test/HUnit/Base.hs 194
-(~?) :: (AssertionPredicable t) => t -> String -> Test
+-- | creates a test case resulting from asserting the condition obtained 
+--   from the specified 'AssertionPredicable'.
+(~?) :: (AssertionPredicable t) => t       -- ^ a value of which the asserted condition is predicated
+                                -> String  -- ^ a message that is displayed on test failure
+                                -> Test
hunk ./Test/HUnit/Base.hs 201
-(~=?) :: (Eq a, Show a) => a -> a -> Test
+-- | shorthand for a test case that asserts equality (with the expected 
+--   value on the left-hand side, and the actual value on the right-hand
+--   side).
+(~=?) :: (Eq a, Show a) => a     -- ^ the expected value 
+                        -> a     -- ^ the actual value
+                        -> Test
hunk ./Test/HUnit/Base.hs 209
-(~?=) :: (Eq a, Show a) => a -> a -> Test
+-- | shorthand for a test case that asserts equality (with the actual 
+--   value on the left-hand side, and the expected value on the right-hand
+--   side).
+(~?=) :: (Eq a, Show a) => a     -- ^ the actual value
+                        -> a     -- ^ the expected value 
+                        -> Test
hunk ./Test/HUnit/Base.hs 217
+-- | creates a test from the specified 'Testable', with the specified 
+--   label attached to it.
hunk ./Test/HUnit/Base.hs 226
+
+-- $testExecutionNote
+-- Note: the rest of the functionality in this module is intended for 
+-- implementors of test controllers. If you just want to run your tests cases,
+-- simply use a test controller, such as the text-based controller in 
+-- "Test.HUnit.Text".
+
hunk ./Test/HUnit/Base.hs 239
-
+
+-- | report generator for reporting the start of a test run.
hunk ./Test/HUnit/Base.hs 242
-
+
+-- | report generator for reporting problems that have occurred during
+--   a test run. Problems may be errors or assertion failures.
hunk ./Test/HUnit/Base.hs 247
-
--- 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)
+-- | performs a test run with the specified report generators.
+--
+--   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   -- ^ report generator for the test run start 
+            -> ReportProblem us -- ^ report generator for errors during the test run
+            -> ReportProblem us -- ^ report generator for assertion failures during the test run
+            -> us 
+            -> Test             -- ^ the test to be executed 
+            -> IO (Counts, us)
hunk ./Test/HUnit/Lang.hs 1
--- HUnit language support.
+-- | HUnit language support.
hunk ./Test/HUnit/Lang.hs 33
--- An assertion is an `IO` computation with trivial result.
+-- | An assertion is an 'IO' computation with trivial result. An assertion or
+--   a sequence of assertions makes up a test case.
hunk ./Test/HUnit/Lang.hs 38
--- `assertFailure` signals an assertion failure with a given message.
+-- | signals an assertion failure with a given message.
hunk ./Test/HUnit/Lang.hs 40
-assertFailure :: String -> Assertion
+assertFailure :: String -- ^ a message that is displayed with the assertion failure 
+              -> Assertion
hunk ./Test/HUnit/Lang.hs 43
--- `performTestCase` performs a single test case.  The meaning of the
--- result is as follows:
---  Nothing               test case success
---  Just (True,  msg)     test case failure with the given message
---  Just (False, msg)     test case error with the given message
+-- | performs a single test case.  The meaning of the result is as follows:
+--
+--     [@Nothing@]           test case success
+--
+--     [@Just (True,  msg)@] test case failure with the given message
+--
+--     [@Just (False, msg)@] test case error with the given message
hunk ./Test/HUnit/Lang.hs 51
-performTestCase :: Assertion -> IO (Maybe (Bool, String))
+performTestCase :: Assertion -- ^ an assertion to be made during the test case run 
+                -> IO (Maybe (Bool, String))
hunk ./Test/HUnit/Terminal.hs 10
--- Simplifies the input string by interpreting '\r' and '\b' characters
--- specially so that the result string has the same final (or "terminal",
--- pun intended) appearance as would the input string when written to a
--- terminal that overwrites character positions following carriage
--- returns and backspaces.
+-- | simplifies the input string by interpreting \'\r\' and \'\b\' characters
+--   specially so that the result string has the same final (or \"terminal\",
+--   pun intended) appearance as would the input string when written to a
+--   terminal that overwrites character positions following carriage
+--   returns and backspaces.
hunk ./Test/HUnit/Terminal.hs 16
--- The helper function `ta` takes an accumulating `ShowS`-style function
--- that holds "committed" lines of text, a (reversed) list of characters
--- on the current line *before* the cursor, a (normal) list of characters
--- on the current line *after* the cursor, and the remaining input.
hunk ./Test/HUnit/Terminal.hs 20
+  -- The helper function `ta` takes an accumulating `ShowS`-style function
+  -- that holds "committed" lines of text, a (reversed) list of characters
+  -- on the current line *before* the cursor, a (normal) list of characters
+  -- on the current line *after* the cursor, and the remaining input.
hunk ./Test/HUnit/Text.hs 1
--- text-based test controller
+-- | Text-based test controller for running HUnit tests and reporting
+--   results as text, usually to a terminal.
hunk ./Test/HUnit/Text.hs 20
--- As the general text-based test controller (`runTestText`) executes a
--- test, it reports each test case start, error, and failure by
--- constructing a string and passing it to the function embodied in a
--- `PutText`.  A report string is known as a "line", although it includes
--- no line terminator; the function in a `PutText` is responsible for
--- terminating lines appropriately.  Besides the line, the function
--- receives a flag indicating the intended "persistence" of the line:
--- `True` indicates that the line should be part of the final overall
--- report; `False` indicates that the line merely indicates progress of
--- the test execution.  Each progress line shows the current values of
--- the cumulative test execution counts; a final, persistent line shows
--- the final count values.
-
--- The `PutText` function is also passed, and returns, an arbitrary state
--- value (called `st` here).  The initial state value is given in the
--- `PutText`; the final value is returned by `runTestText`.
+-- | As the general text-based test controller ('runTestText') executes a
+--   test, it reports each test case start, error, and failure by
+--   constructing a string and passing it to the function embodied in a
+--   'PutText'.  A report string is known as a \"line\", although it includes
+--   no line terminator; the function in a 'PutText' is responsible for
+--   terminating lines appropriately.  Besides the line, the function
+--   receives a flag indicating the intended \"persistence\" of the line:
+--   'True' indicates that the line should be part of the final overall
+--   report; 'False' indicates that the line merely indicates progress of
+--   the test execution.  Each progress line shows the current values of
+--   the cumulative test execution counts; a final, persistent line shows
+--   the final count values.
+--
+--   The 'PutText' function is also passed, and returns, an arbitrary state
+--   value (called 'st' here).  The initial state value is given in the
+--   'PutText'; the final value is returned by 'runTestText'.
hunk ./Test/HUnit/Text.hs 45
--- `putTextToHandle` writes persistent lines to the given handle,
--- following each by a newline character.  In addition, if the given flag
--- is `True`, it writes progress lines to the handle as well.  A progress
--- line is written with no line termination, so that it can be
--- overwritten by the next report line.  As overwriting involves writing
--- carriage return and blank characters, its proper effect is usually
--- only obtained on terminal devices.
+-- | writes persistent lines to the given handle, following each by a newline 
+--   character.  In addition, if the given flag is 'True', it writes progress 
+--   lines to the handle as well.  A progress line is written with no line 
+--   termination, so that it can be  overwritten by the next report line.
+--   As overwriting involves writing carriage return and blank characters, its
+--   proper effect is usually only obtained on terminal devices.
hunk ./Test/HUnit/Text.hs 64
--- `putTextToShowS` accumulates persistent lines (dropping progess lines)
--- for return by `runTestText`.  The accumulated lines are represented by
--- a `ShowS` (`String -> String`) function whose first argument is the
--- string to be appended to the accumulated report lines.
+-- | accumulates persistent lines (dropping progess lines) for return by 
+--   'runTestText'.  The accumulated lines are represented by a 
+--   @'ShowS' ('String' -> 'String')@ function whose first argument is the
+--   string to be appended to the accumulated report lines.
hunk ./Test/HUnit/Text.hs 75
--- `runTestText` executes a test, processing each report line according
--- to the given reporting scheme.  The reporting scheme's state is
--- threaded through calls to the reporting scheme's function and finally
--- returned, along with final count values.
+-- | executes a test, processing each report line according to the given 
+--   reporting scheme.  The reporting scheme's state is threaded through calls 
+--   to the reporting scheme's function and finally returned, along with final 
+--   count values.
hunk ./Test/HUnit/Text.hs 95
--- `showCounts` converts test execution counts to a string.
+-- | converts test execution counts to a string.
hunk ./Test/HUnit/Text.hs 104
--- `showPath` converts a test case path to a string, separating adjacent
--- elements by ':'.  An element of the path is quoted (as with `show`)
--- when there is potential ambiguity.
+-- | converts a test case path to a string, separating adjacent elements by 
+--   the colon (\':\'). An element of the path is quoted (as with 'show') when
+--   there is potential ambiguity.
hunk ./Test/HUnit/Text.hs 117
--- `runTestTT` provides the "standard" text-based test controller.
--- Reporting is made to standard error, and progress reports are
--- included.  For possible programmatic use, the final counts are
--- returned.  The "TT" in the name suggests "Text-based reporting to the
--- Terminal".
+-- | provides the \"standard\" text-based test controller. Reporting is made to
+--   standard error, and progress reports are included. For possible 
+--   programmatic use, the final counts are returned.
+--
+--   The \"TT\" in the name suggests \"Text-based reporting to the Terminal\".
}

Context:

[--configure-option and --ghc-option are now provided by Cabal
Ross Paterson <ross@soi.city.ac.uk>**20070604115936] 
[FIX #476 (HUnit treats failures as errors)
Simon Marlow <simonmar@microsoft.com>**20070530100832
 Patch submitted by stefanheimann via Trac
] 
[old nhc98 Makefiles now obsolete
Malcolm.Wallace@cs.york.ac.uk**20070525133446] 
[remove Makefile.inc (only affects nhc98)
Malcolm.Wallace@cs.york.ac.uk**20070320120854] 
[Remove Makefile and package.conf.in (used in the old GHC build system)
Ian Lynagh <igloo@earth.li>**20070524145605] 
[TAG GHC 6.6.1 release
Ian Lynagh <igloo@earth.li>**20070428195851] 
Patch bundle hash:
4dd2e2672e0214de4a0a84e1698fb1e17031732b