    -- | Text-based test controller for running HUnit tests and reporting
    --   results as text, usually to a terminal.

    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 -- ^ Write progress lines to handle?
        -> 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 _   = 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"

    -- | 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 rest = f (line ++ '\n' : rest)

    -- | 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 us0) t = do
      (counts', us1) <- performTest reportStart reportError reportFailure us0 t
      us2 <- put (showCounts counts') True us1
      return (counts', us2)
     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)

    -- | 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'

    -- | 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.

    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

    -- | 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'