{- |
  This is the main testing module. Start reading here if you want to
  know what this package is all about.

  There's a documentation section at the bottom of this page. You
  might want to start by reading that. Otherwise, here's a quick
  summary:

  * You create 'Test' objects to represent your tests.

  * @'run_test' :: 'Test' -> 'IO' 'Bool'@ to quickly run a test
    interactively (e.g., during debugging activity).

  * 'run_test_full' allows more control, including recording detailed
    test results to an XML log file.

  * @'test' :: 'Bool' -> 'Test'@ creates a test from pure code.

  * @('?=') :: 'Eq' x => x -> x -> 'Test'@ for tests with known
    answers.

  * Tests can be annotated with 'title', 'argument', 'temporary',
    'note' and so on.

  * @'tests' :: ['Test'] -> 'Test'@ for combining multiple tests
    into a single 'Test' object. Tests can be nested arbitrarily
    in this mannar to group related tests together.

  * @'testIO' :: 'IO' 'Bool' -> 'Test'@ for tests that need to
    perform I/O.

  * The 'TestM' monad supports 'liftIO' and allows limited test
    annotations from within monadic code.

  * @'testM' :: 'TestM' 'Bool' -> 'Test'@ to use the 'TestM' monad.

  * 'throws', 'throwsIO', 'throwsM' to test for exceptions.
-}

module Test.AC.Test
    (
      -- * Types
      Test(),

      -- * Pure tests
      -- ** Creation
      -- *** Simple tests
      test, inapplicable,

      -- *** Exceptions
      throws_, throws,

      -- *** Comparisons
      (?=), (?/=), (?<), (?<=), (?>), (?>=),

      -- ** Annotations
      title, argument, argument_, temporary, temporary_, note,

      -- * Impure tests

      -- ** In the @IO@ monad
      testIO, testIO3, throws_IO, throwsIO,

      -- ** In the @TestM@ monad
      -- *** Types
      TestM (),

      -- *** Creation
      testM, throws_M, throwsM,

      -- *** Annotations
      inapplicableM, temporaryM, temporaryM_, noteM,

      -- * Combining tests
      tests, alternatives,

      -- * Running tests
      run_test, run_test_full, TestConfig (..), default_config,

      -- * Mini-guide
      -- $Guide
    )
  where

import Control.Monad.IO.Class
import System.IO (stdout) -- For Haddock.

import Test.AC.Private

---------------------------------------------------------------------

-- | An executable test.
newtype Test = Test (LogM Bool)

---------------------------------------------------------------------

result_nostack :: Bool -> LogM Bool
result_nostack b =
  if b
    then log_mark "pass" >> return b
    else log_mark "fail" >> return b

result :: Bool -> LogM Bool
result b =
  if b
    then                result_nostack b
    else stack_trace >> result_nostack b

stack_report_error :: String -> LogM ()
stack_report_error msg = stack_report ("Test.AC.Test." ++ msg)

---------------------------------------------------------------------

{- |
  Create a 'Test' from a simple 'Bool' value.

  The test passes if the value is 'True'. The test fails if the value
  is 'False', or if an exception is thrown in the course of computing
  the value.
-}
test :: Bool -> Test
test b0 = Test $ do
  log_mark "pure"
  log_element "result" $ do
    mb1 <- force b0
    case mb1 of
      Just True  -> result True
      Just False -> do
        stack_report_error "test: False"
        result False
      Nothing    -> do
        stack_report_error "test: Exception thrown."
        result False

{- |
  This test always succeeds, but writes a note in the log to say that
  the test case was \"inapplicable\".

  This is generally useful if you have a test generation function
  which doesn't work for certain combinations of inputs. In that
  instance, the test still passes, but there is a note in the log
  letting you know it was only a \"null\" test.
-}
inapplicable :: Test
inapplicable = Test $ do
  log_mark "inapplicable"
  log_element "result" $ result_nostack True

---------------------------------------------------------------------

{- |
  Test for exceptions.

  Ordinarily, any test which throws an exception is deemed to have
  failed. However, this test /passes/ if evaluating the argument to
  WHNF causes an exception to be thrown. The test /fails/ if no
  exception is thrown.

  This can be useful for checking that functions reject invalid input
  by throwing an exception. (Of course, you cannot check that the
  /correct/ exception is thrown!)

  If WHNF is not enough to trigger the exception, you can wrap the
  expression in some suitable forcing function. (The function
  'length' '.' 'show' can sometimes be used for this purpose.)

  Note that an infinite loop is not an exception (unless the loop
  exhausts some resource).

  If an exception is not thrown, the actual value returned is not
  recorded. See 'throws' for a function that records this
  information. (Note that this requires adding a 'Show' constraint.)
-}
throws_ :: x -> Test
throws_ x0 = Test $
  log_element "result" $ do
    mx1 <- force x0
    case mx1 of
      Just  _ -> do
        stack_report_error "throws_: No exception was thrown."
        result False
      Nothing -> result True

{- |
  Test for exceptions.

  Ordinarily, any test which throws an exception is deemed to have
  failed. However, this test /passes/ if evaluating the argument to
  WHNF causes an exception to be thrown. The test /fails/ if no
  exception is thrown.

  This can be useful for checking that functions reject invalid input
  by throwing an exception. (Of course, you cannot check that the
  /correct/ exception is thrown!)

  If WHNF is not enough to trigger the exception, you can wrap the
  expression in some suitable forcing function. (The function
  'length' '.' 'show' can sometimes be used for this purpose.)

  Note that an infinite loop is not an exception (unless the loop
  exhausts some resource).

  If no exception is thrown, the actual value returned is recorded.
  This requires adding a 'Show' constraint. See 'throws_' for a
  function without this constraint.
-}
throws :: Show x => x -> Test
throws x0 = Test $
  log_element "result" $ do
    mx1 <- force x0
    case mx1 of
      Just x1 -> do
        log_element_ "value" $ show x1
        stack_report_error "throws: No exception was thrown."
        stack_report $ "Result: " ++ show x1
        result False
      Nothing -> result True

---------------------------------------------------------------------

infix 4 ?=, ?/=, ?<, ?<=, ?>, ?>=

{- |
  Compare two values for equality.

  The right-hand value is the \"target\" value, and the left-hand
  value (next to the @?@ sign) is the \"actual\" value. The test
  passes if both values are equal according to '=='. The test fails
  if any exceptions are thrown by '==' or 'show'.

  This operator has the same precedence as '==' (i.e., 4).
-}
(?=) :: (Eq x, Show x) => x -> x -> Test
(?=) =
  test_compare
    (==)
    (log_mark "equal-to-target")
    "(?=): Values do not match."
    "(?=): Exception in Prelude.(==)."

{- |
  Compare two values for inequality.

  The right-hand value is the \"target\" value, and the left-hand
  value (next to the @?@ sign) is the \"actual\" value. The test
  passes if both values are unequal according to '/='. The test fails
  if any exceptions are thrown by '/=' or 'show'.

  This operator has the same precedence as '/=' (i.e., 4).
-}
(?/=) :: (Eq x, Show x) => x -> x -> Test
(?/=) =
  test_compare
    (/=)
    (log_mark "not-equal-to-target")
    "(?/=): Values are equal."
    "(?/=): Exception in Prelude.(/=)."

{- |
  Compare two values for inequality.

  The right-hand value is the \"target\" value, and the left-hand
  value (next to the @?@ sign) is the \"actual\" value. The test
  passes if the actual value is less than the target value according
  to '<'. The test fails if any exceptions are thrown by '<' or
  'show'.

  This operator has the same precedence as '<' (i.e., 4).
-}
(?<) :: (Ord x, Show x) => x -> x -> Test
(?<) =
  test_compare
    (<)
    (log_mark "less-than-target")
    "(?<): Actual is no less than target."
    "(?<): Exception in Prelude.(<)."

{- |
  Compare two values for inequality.

  The right-hand value is the \"target\" value, and the left-hand
  value (next to the @?@ sign) is the \"actual\" value. The test
  passes if the actual value is less than or equal to the target
  value according to '<='. The test fails if any exceptions are
  thrown by '<=' or 'show'.

  This operator has the same precedence as '<=' (i.e., 4).
-}
(?<=) :: (Ord x, Show x) => x -> x -> Test
(?<=) =
  test_compare
    (<=)
    (log_mark "less-than-target" >> log_mark "equal-to-target")
    "(?<=): Actual is greater than target."
    "(?<=): Exception in Prelude.(<=)."

{- |
  Compare two values for inequality.

  The right-hand value is the \"target\" value, and the left-hand
  value (next to the @?@ sign) is the \"actual\" value. The test
  passes if the actual value is more than the target value according
  to '>'. The test fails if any exceptions are thrown by '>' or
  'show'.

  This operator has the same precedence as '>' (i.e., 4).
-}
(?>) :: (Ord x, Show x) => x -> x -> Test
(?>) =
  test_compare
    (>)
    (log_mark "more-than-target")
    "(?>): Actual is no greater than target."
    "(?>): Exception in Prelude.(>)."

{- |
  Compare two values for inequality.

  The right-hand value is the \"target\" value, and the left-hand
  value (next to the @?@ sign) is the \"actual\" value. The test
  passes if the actual value is more than or equal to the target
  value according to '>='. The test fails if any exceptions are
  thrown by '>=' or 'show'.

  This operator has the same precedence as '>=' (i.e., 4).
-}
(?>=) :: (Ord x, Show x) => x -> x -> Test
(?>=) =
  test_compare
    (>=)
    (log_mark "more-than-target" >> log_mark "equal-to-target")
    "(?>=): Actual is less than target."
    "(?>=): Exception in Prelude.(>=)."

test_compare :: (Show x) => (x -> x -> Bool) -> LogM () -> String -> String -> x -> x -> Test
test_compare op marks msg_fail msg_exception act exp = Test $ do
  log_mark     "pure"
  log_element  "compare" $ do
    marks
    log_element_ "target" (show exp)
    log_element_ "actual" (show act)
  stack_report $ "Target: " ++ show exp
  stack_report $ "Actual: " ++ show act
  log_element "result" $ do
    mb1 <- force (act `op` exp)
    case mb1 of
      Just True  -> result True
      Just False -> do
        stack_report_error msg_fail
        result False
      Nothing    -> do
        stack_report_error msg_exception
        result False

---------------------------------------------------------------------

perform_test :: String -> LogM Bool -> LogM Bool
perform_test name test = do
  mb <- log_exceptions test
  case mb of
    Just b  -> return b
    Nothing -> do
      stack_report_error (name ++ ": Exception accessing test object.")
      log_element "result" $ result False

{- |
  Attach a title to a test.

  This title is an arbitrary human-readable label. It is recorded in
  relation to the test, but has no other function.
-}
title :: String -> Test -> Test
title title (Test test) = Test $ do
  log_element_ "title" title
  stack_report ("Test '" ++ title ++ "'")
  print_title  title
  perform_test "title" test

{- |
  Attach an argument value note.

  The 'String' is the argument name, and the @x@ is that argument's
  value, which must implement 'show'.
-}
argument :: (Show x) => String -> x -> Test -> Test
argument name x = argument_ name (show x)

{- |
  Attach an argument value note.

  The first 'String' is the argument name, and the second is some
  suitable textual representation of that argument's value.
-}
argument_ :: String -> String -> Test -> Test
argument_ name x (Test test) = Test $ do
  log_element "argument" $ do
    log_element_ "name" name
    log_element_ "value" x
  stack_report $ "Argument '" ++ name ++ "' = " ++ x
  perform_test "argument_" test

{- |
  Note down a temporary intermediate value computed in the process
  of constructing a test.

  The 'String' is a name for this value, and the @x@ is the value
  itself, which must implement 'show'.
-}
temporary :: (Show x) => String -> x -> Test -> Test
temporary name x = temporary_ name (show x)

{- |
  Note down a temporary intermediate value computed in the process
  of constructing a test.

  The first 'String' is the temporary name, and the second is some
  suitable textual representation of the temporary's value.
-}
temporary_ :: String -> String -> Test -> Test
temporary_ name x (Test test) = Test $ do
  log_element "temporary" $ do
    log_element_ "name" name
    log_element_ "value" x
  stack_report $ "Temporary '" ++ name ++ "' = " ++ x
  perform_test "temporary_" test

{- |
  Add a textual note to the test log.
-}
note :: String -> Test -> Test
note txt (Test test) = Test $ do
  log_element_ "note" txt
  stack_report $ "Note: " ++ txt
  perform_test "note" test

---------------------------------------------------------------------

{- |
  Create a 'Test' from an 'IO' action that returns a 'Bool'.

  The test passes if the value returned is 'True'. The test fails if
  the value returned is 'False', or if an uncaught exception escapes.
-}
testIO :: IO Bool -> Test
testIO act = Test $ do
  log_mark "impure"
  mb0 <- log_element "run" $ log_exceptions $ rawIO act
  log_element "result" $ do
    mb1 <- maybe (return Nothing) force mb0
    case mb1 of
      Just True  -> result True
      Just False -> do
        stack_report_error "testIO: return False"
        result False
      Nothing    -> do
        stack_report_error "testIO: Uncaught exception."
        result False

{- |
  Create a 'Test' from an 'IO' action with seperate set-up and
  clean-up phases.

  The first argument is a set-up action. This might be used to
  initialise mutable storage or create disk structures, or just to
  open some handles. Its result is passed to the second argument,
  which then does the actual test propper. Finally, the third
  argument is run (again with the set-up result as argument) to do
  any post-test clean-up operations required. Its result is
  discarded.

  If any of these 'IO' actions throw an exception, the test is
  marked failed. Note that if the set-up action throws an exception,
  the test and clean-up actions are not run. (If only the main test
  action throws an exception, the clean-up is still run.)
-}
testIO3 :: IO x -> (x -> IO Bool) -> (x -> IO y) -> Test
testIO3 act1 act2 act3 = Test $ do
  log_mark "impure"
  mx <- log_element "set-up" $ log_exceptions $ rawIO act1
  case mx of
    Nothing -> do
      stack_report_error "testIO3: Uncaught exception in set-up."
      log_element "result" $ result False
    Just  x -> do
      mb0 <- log_element "run"      $ log_exceptions $ rawIO (act2 x)
      mc  <- log_element "clean-up" $ log_exceptions $ rawIO (act3 x)
      log_element "result" $ do
        mb1 <- maybe (return Nothing) force mb0
        case mb1 of
          Just True  ->
            case mc of
              Just  _ -> result True
              Nothing -> do
                stack_report_error "testIO3: Uncaught exception in clean-up."
                result False
          Just False -> do
            stack_report_error "testIO3: return False"
            result False
          Nothing    -> do
            stack_report_error "testIO3: Uncaught exception."
            result False

{- |
  Test for exceptions in the 'IO' monad.

  Ordinarily, any test which throws an exception is deemed to have
  failed. However, this test /passes/ if evaluating the action's
  result to WHNF causes an exception to be thrown. The test /fails/
  if no exception is thrown.

  This can be useful for checking that a function rejects invalid
  input by throwing an exception, or that invalid I/O operations are
  reported. (Of course, you cannot check that the /correct/ exception
  is thrown!)

  Note that the 'IO' action is run /and/ its result is reduced (to
  WHNF only). Note also that infinite loops are not exceptions
  (unless the loop exhausts some resource).

  If no exception is thrown, the actual value returned is not
  recorded. See 'throwsIO' for a function which does record this
  information. (This requires adding a 'Show' constraint.)
-}
throws_IO :: IO x -> Test
throws_IO act = Test $ do
  mx0 <- log_element "run" $ log_exceptions $ rawIO act
  log_element "result" $ do
    case mx0 of
      Nothing -> result True
      Just x0 -> do
        mx1 <- force x0
        case mx1 of
          Nothing -> result True
          Just _  -> do
            stack_report_error "throwsIO: No exception was thrown."
            result False

{- |
  Test for exceptions in the 'IO' monad.

  Ordinarily, any test which throws an exception is deemed to have
  failed. However, this test /passes/ if evaluating the action's
  result to WHNF causes an exception to be thrown. The test /fails/
  if no exception is thrown.

  This can be useful for checking that a function rejects invalid
  input by throwing an exception, or that invalid I/O operations are
  reported. (Of course, you cannot check that the /correct/ exception
  is thrown!)

  Note that the 'IO' action is run /and/ its result is reduced (to
  WHNF only). Note also that infinite loops are not exceptions
  (unless the loop exhausts some resource).

  If no exception is thrown, the actual value returned is recorded.
  This requires adding a 'Show' constraint; see 'throws_IO' for a
  function without this constraint.
-}
throwsIO :: Show x => IO x -> Test
throwsIO act = Test $ do
  mx0 <- log_element "run" $ log_exceptions $ rawIO act
  log_element "result" $ do
    case mx0 of
      Nothing -> result True
      Just x0 -> do
        mx1 <- force x0
        case mx1 of
          Nothing -> result True
          Just x1 -> do
            log_element_ "value" $ show x1
            stack_report_error "throwsIO: No exception was thrown."
            stack_report $ "Result: " ++ show x1
            result False

---------------------------------------------------------------------

{- |
  The test monad.

  Notice the 'MonadIO' instance. This allows you to call 'liftIO' to
  perform arbitrary 'IO' actions at any point within the test monad.
-}
newtype TestM x = TestM (LogM x)

instance Monad TestM where
  return = TestM . return

  (TestM m1) >>= f = TestM $ m1 >>= \ x -> let TestM m2 = f x in m2

instance MonadIO TestM where
  liftIO act = TestM $ rawIO act

---------------------------------------------------------------------

{- |
  Create a 'Test' from a 'TestM' action.

  The test passes if the 'TestM' action returns 'True'. The test
  fails if it returns 'False' or an uncaught exception escapes.
-}
testM :: TestM Bool -> Test
testM (TestM act) = Test $ do
  log_mark "impure"
  mb0 <- log_element "run" $ log_exceptions act
  log_element "result" $ do
    mb1 <- maybe (return Nothing) force mb0
    case mb1 of
      Just True  -> result True
      Just False -> do
        stack_report_error "testM: return False"
        result False
      Nothing    -> do
        stack_report_error "testM: Uncaught exception."
        result False

{- |
  Check a 'TestM' action for exceptions.

  Ordinarily, any test which throws an exception is deemed to have
  failed. However, this test /passes/ if evaluating the action's
  result to WHNF causes an exception to be thrown. The test /fails/
  if no exception is thrown.

  This can be useful for checking that a function rejects invalid
  input by throwing an exception, or that invalid I/O operations are
  reported. (Of course, you cannot check that the /correct/ exception
  is thrown!)

  Note that the 'TestM' action is run /and/ its result is reduced (to
  WHNF only). Note also that infinite loops are not exceptions
  (unless the loop exhausts some resource).

  If no exception is thrown, the actual value returned is not
  recorded. See 'throwsM' for a function that does record the value.
  This requires adding a 'Show' constraint.
-}
throws_M :: TestM x -> Test
throws_M (TestM act) = Test $ do
  log_mark "impure"
  mx0 <- log_element "run" $ log_exceptions act
  log_element "result" $ do
    case mx0 of
      Nothing -> result True
      Just x0 -> do
        mx1 <- force x0
        case mx1 of
          Nothing -> result True
          Just _  -> do
            stack_report_error "throwsM: No exception was thrown."
            result False

{- |
  Check a 'TestM' action for exceptions.

  Ordinarily, any test which throws an exception is deemed to have
  failed. However, this test /passes/ if evaluating the action's
  result to WHNF causes an exception to be thrown. The test /fails/
  if no exception is thrown.

  This can be useful for checking that a function rejects invalid
  input by throwing an exception, or that invalid I/O operations are
  reported. (Of course, you cannot check that the /correct/ exception
  is thrown!)

  Note that the 'TestM' action is run /and/ its result is reduced (to
  WHNF only). Note also that infinite loops are not exceptions
  (unless the loop exhausts some resource).

  If no exception is thrown, the actual value returns is recorded.
  This requires adding a 'Show' constraint. See 'throws_M' for a
  function without this constraint.
-}
throwsM :: Show x => TestM x -> Test
throwsM (TestM act) = Test $ do
  log_mark "impure"
  mx0 <- log_element "run" $ log_exceptions act
  log_element "result" $ do
    case mx0 of
      Nothing -> result True
      Just x0 -> do
        mx1 <- force x0
        case mx1 of
          Nothing -> result True
          Just x1 -> do
            log_element_ "value" $ show x1
            stack_report_error "throwsM: No exception was thrown."
            stack_report $ "Result: " ++ show x1
            result False

---------------------------------------------------------------------

{- |
  Mark the current test as \"inapplicable\" and return 'True'.
  (See 'inapplicable'.)
-}
inapplicableM :: TestM Bool
inapplicableM = TestM $ do
  log_mark "inapplicable"
  return True

{- |
  Note down a temporary intermediate value computed in the process
  of constructing a test.

  The 'String' is a name for this value, and the @x@ is the value
  itself, which must implement 'show'.
-}
temporaryM :: (Show x) => String -> x -> TestM ()
temporaryM name x = temporaryM_ name (show x)

{- |
  Note down a temporary intermediate value computed in the process
  of constructing a test.

  The first 'String' is the name, and the second is some suitable
  textual representation of the value.
-}
temporaryM_ :: String -> String -> TestM ()
temporaryM_ name x = TestM $ do
  log_element "temporary" $ do
    log_element_ "name" name
    log_element_ "value" x
  stack_report $ "Temporary '" ++ name ++ "' = " ++ x

{- |
  Add a textual note to the log file.
-}
noteM :: String -> TestM ()
noteM txt = TestM $ do
  log_element_ "note" txt
  stack_report $ "Note: " ++ txt

---------------------------------------------------------------------

{- |
  Combine multiple tests into a single composite test.

  The composite test fails if any of its constituent tests fail.
  Whether the remaining tests are run depends on the testing mode
  (the 'cfg_FailAbort' parameter in 'TestConfig').

  Essentially, this takes the logical-AND of several tests. You can
  achieve the same result using the normal '&&' operator or the 'and'
  function, operating on plain 'Bool' values rather than 'Test'
  objects. However, by turning subexpressions into 'Test' objects and
  using 'tests', the result of each subexpression will be logged to
  file in addition to the overall result. Depending on the context,
  that may or may not be helpful. You decide which you want.
-}
tests :: [Test] -> Test
tests = Test . root
  where
    root ts = do
      mb <- log_element "tests" $ work True ts
      log_element "result" $
        case mb of
          Just  b -> result_nostack b
          Nothing -> result False

    work b0 ts0 = do
      mts1 <- force ts0
      case mts1 of
        Just []             -> return (Just b0)
        Just (Test t : ts2) -> do
          b1 <- subroutine $ log_element "test" $ perform_test "tests" t
          if b0 && b1
            then work True ts2
            else do
              s <- fail_stop
              if s
                then return (Just False)
                else work False ts2
        Nothing             -> do
          stack_report_error "tests: Exception accessing test list spine."
          return Nothing

{- |
  Create a composite test which passes if at least one child test
  passes.

  All child tests are always run, regardless of error reporting mode.
  No test failures are reported, unless all children fail.

  Essentially, this takes the logical-OR of several tests. You can
  achieve the same result using the normal '||' operator or the 'or'
  function, operating on plain 'Bool' values rather than 'Test'
  objects. However, by turning subexpressions into 'Test' objects and
  using 'alternatives', the result of each subexpression will be
  logged to file in addition to the overall result. Depending on the
  context, that may or may not be helpful. You decide which you want.
-}
alternatives :: [Test] -> Test
alternatives = Test . root
  where
    root ts = do
      mb <- log_element "alternatives" $ work False ts
      log_element "result" $
        case mb of
          Just True  -> result True
          Just False -> do
            stack_report_error "alternatives: All child tests failed."
            result False
          Nothing    -> result False

    work b0 ts0 = do
      mts1 <- force ts0
      case mts1 of
        Just []             -> return (Just b0)
        Just (Test t : ts2) -> do
          b1 <- log_element "test" $ silence_failures $ subroutine $ perform_test "alternatives" t
          work (b0 || b1) ts2
        Nothing             -> do
          stack_report_error "alternatives: Exception accessing test list spine."
          return Nothing

---------------------------------------------------------------------

{- |
  Execute a test.

  Ordinarily, \"the test\" will be a composite test created with
  'tests', and will actually contain multiple sub-tests within it.

  A 'Bool' value is returned indicating whether the test was
  successful or not. Test progress information is printed to
  'stdout'. If any test fails, detailed information for that test is
  printed to 'stdout', and testing aborts.

  For more control, see 'run_test_full'.
-}
run_test :: Test -> IO Bool
run_test = run_test_full default_config

{- |
  Execute a test.

  Ordinarily, \"the test\" will be a composite test created with
  'tests', and will actually contain multiple sub-tests within it.

  A 'Bool' value is returned indicating whether the test was
  successful or not. Test progress information is printed to
  'stdout'. Various testing options can be configured using the
  'TestConfig' argument. In particular, it is possible to log
  detailed testing data to an XML log file (the 'cfg_LogFile'
  parameter).

  The related 'run_test' function runs a test with the
  'default_config' test settings, which are useful for quick
  interactive testing during a debugging session.
-}
run_test_full :: TestConfig -> Test -> IO Bool
run_test_full c (Test t) = do
  putStrLn "Starting test run..."
  b <- case cfg_LogFile c of
    Nothing -> run         (cfg_FailAbort c) (cfg_FailReport c) $ t
    Just f1 -> run_file f1 (cfg_FailAbort c) (cfg_FailReport c) $ do
      log_header
      case cfg_LogXSL c of
        Nothing -> return ()
        Just f2 -> log_XSL f2
      log_element "test" t
  putStr "Test run "
  if b
    then putStrLn "PASSED."
    else putStrLn "FAILED."
  putStrLn ""
  return b

-- | Configuration settings for a test run.
data TestConfig =
  TestConfig
  {
    {- |
      If 'Nothing', no log file is produced. Otherwise, this is the
      full path to the XML log file.
    -}
    cfg_LogFile    :: Maybe FilePath,

    {- |
      Path to an XSL file. If given, the XML log file will use this
      XSL as a stylesheet. This value is ignored if no XML log is
      produced.
    -}
    cfg_LogXSL     :: Maybe String,

    {- |
      If 'True', report test failures to 'stdout'. If 'False', just
      report test progress to 'stdout'.
    -}
    cfg_FailReport :: Bool,

    {- |
      If 'True', abort testing if a test fails, otherwise continue
      testing. (In other words, 'False' causes /all/ tests to be
      run, regardless of test failures, while 'True' runs until a
      test fails and then stops.)
    -}
    cfg_FailAbort  :: Bool
  }

{- |
  The default test configuration, as used by 'run_test'.

  >cfg_LogFile    = Nothing
  >cfg_LogXSL     = Nothing
  >cfg_FailReport = True
  >cfg_FailAbort  = True

  You can use this as a starting point if you only want to customise
  a few test settings. (More options may be added in future.)
-}
default_config :: TestConfig
default_config =
  TestConfig
  {
    cfg_LogFile    = Nothing,
    cfg_LogXSL     = Nothing,
    cfg_FailReport = True,
    cfg_FailAbort  = True
  }

---------------------------------------------------------------------

{- $Guide
  Tests are represented by 'Test' objects.

  You can run such a test using
  @'run_test' :: 'Test' -> 'IO' 'Bool'@.
  This is intended for quickly running a test or two interactively to
  see if those code changes you just made fixed the bug or not. For
  running an entire test suite, you probably want 'run_test_full'.
  This uses a 'TestConfig' object to set testing options; in
  particular, detailed test information can be written to an XML log
  file. Most test annotations only affect the log file, not the
  visible output on 'stdout'.

  You can create a test in several ways. The easiest is
  @'test' :: 'Bool' -> 'Test'@.
  For example, a simple hard-coded test might look like

  >t_null_empty :: Test
  >t_null_empty = test $ SET.null SET.empty

  You can also add a test title:

  >t_null_empty :: Test
  >t_null_empty =
  >  title "null empty" $
  >  test $
  >  SET.null SET.empty

  Running this test produces a log entry which looks something like

  >  <test>
  >    <title>null empty</title>
  >    <pure/>
  >    <result><pass/></result>
  >  </test>

  (Assuming the implementation of your 'SET' module isn't broken,
  obviously.) I like to set the test 'title' to be the Haskell
  expression that I'm testing (or some approximation of it), but
  there's no law that says you have to do it like that. You can name
  it whatever you like.

  More often, you'll have a function that takes some inputs and
  generates a test object. For example:

  >p_head_member :: Ord x => [x] -> Test
  >p_head_member xs =
  >  title "head xs `member` fromList xs" $
  >  argument "xs" xs $
  >  let set = SET.fromList xs in
  >  temporary "fromList xs" set $
  >  if LIST.null xs
  >    then inapplicable
  >    else test $ head xs `SET.member` set

  Running this test might produce a log entry such as

  >  <test>
  >    <title>head xs `member` fromList xs</title>
  >    <argument><name>xs</name><value>fromList [3,1,4]</value></argument>
  >    <temporary><name>fromList xs</name><value>fromList [1,3,4]</value></temporary>
  >    <pure/>
  >    <result><pass/></result>
  >  </test>

  Of course, 'head' is not defined on an empty list. In that case,
  the code above is configured to mark the test as 'inapplicable'.
  The resulting log entry looks like

  >  <test>
  >    <title>head xs `member` fromList xs</title>
  >    <argument><name>xs</name><value>fromList []</value></argument>
  >    <temporary><name>fromList xs</name><value>fromList []</value></temporary>
  >    <inapplicable/>
  >    <result><pass/></result>
  >  </test>

  The test is still \"successul\", but we have marked it so that
  anyone reading the log will know that this particular test
  \"did nothing\".

  For tests with a known correct answer, you can also use the
  @('?=') :: 'Eq' x => x -> x -> 'Test'@
  operator. For example,

  >p_size :: Ord x => [x] -> Test
  >p_size xs =
  >  title "size (fromList xs) == length (nub xs)" $
  >  argument "xs" xs $
  >  temporary "fromList xs" (SET.fromList xs) $
  >  temporary "nub xs" (LIST.nub xs) $
  >  SET.size (SET.fromList xs) ?= LIST.length (LIST.nub xs)

  Running that might produce something like

  >  <test>
  >    <title>size (fromList xs) == length (nub xs)</title>
  >    <argument><name>xs</name><value>[3,1,4,1]</value></argument>
  >    <temporary><name>fromList xs</name><value>fromList [1,3,4]</value></temporary>
  >    <temporary><name>nub xs</name><value>[3,1,4]</value></temporary>
  >    <pure/>
  >    <compare>
  >      <equal-to-target/>
  >      <target>3</target>
  >      <actual>3</actual>
  >    </compare>
  >    <result><pass/></result>
  >  </test>

  In this instance, the output indicates that @size (fromList xs)@
  was supposed to yield 3, and the value /actually/ produced was also
  3 - and hence, the test passed. There are several similar operators
  such as '?>', '?<' and so forth for inequality testing using an
  'Ord' instance.

  One test case probably isn't particularly useful. But using the
  @'tests' :: ['Test'] -> 'Test'@
  function, you can combine multiple tests into a single composite
  'Test' object. You can have multiple levels of this grouping to
  organise related tests together. Composite tests can of course
  have titles just like any other kind of test.

  Note that this package (unlike, say, QuickCheck) provides no
  facility for generating test data automatically. That's your
  problem. You can solve it in several ways. One idea might be

  >t_size :: Test
  >t_size = tests $ map p_size [ [], [5], [5,5], [4,6], [1..10] ]

  Because this package doesn't deal with test data generation, you
  are free to use any approach you like. In particular, different
  properties can be tested with different test data (rather than
  relying on the type system to select test data for you), the data
  can be random or deterministic, and it can even be loaded from an
  external disk file if you like. Hell, you can even spawn an
  external OS process running a reference implementation, and then
  compare the results from your Haskell code against that. The choice
  is endless.

  If you want to test code that needs to perform I/O, you can use the
  @'testIO' :: 'IO' 'Bool' -> 'Test'@
  function. Impure tests such as this can be annotated in all the
  usual ways. For example,

  >p_makedir :: FilePath -> Test
  >p_makedir dir =
  >  title "p_makedir" $
  >  argument "dir" dir $
  >  testIO $ do
  >    createDirectory dir
  >    doesDirectoryExist dir

  If the test involves setup and cleanup steps, or just resource
  allocation and subsequent deallocation, then you can build those
  into the main test body, or you can use 'testIO3' instead. This has
  the added advantage that it handles exceptions in the test body and
  still runs the cleanup stage. (We /are/ testing code which might
  well crash, after all.) The choice is entirely up to you.

  While you're in the 'IO' monad, you unfortunately cannot use
  functions such as 'temporary' or 'note'. To get around this
  limitation, you can use the 'TestM' monad. It implements 'liftIO',
  so you can still perform any I/O operations you want. But it also
  provides 'temporaryM' and 'noteM', which run inside the monad. The
  @'testM' :: 'TestM' 'Bool' -> 'Test'@ function lets you wrap
  everything up onto a regular 'Test' object when you're done.

  Some functions (e.g., 'head') are supposed to throw an exception
  under certain circumstances. To check that they do (rather than,
  say, return gibberish data instead), you can use 'throws' (or
  'throwsIO' in the 'IO' monad, or 'throwsM' in the 'TestM' monad).
-}