    -- | This module abstracts the differences between implementations of
    -- Haskell (e.g., GHC, Hugs, and NHC).

    {-# LANGUAGE CPP #-}
    #if __GLASGOW_HASKELL__ >= 707
    {-# LANGUAGE DeriveDataTypeable #-}
    #endif

    module Test.HUnit.Lang
    (
      Assertion,
      assertFailure,
      performTestCase,
    #if defined(__GLASGOW_HASKELL__) || defined(__HUGS__)
    -- * Internals
    -- |
    -- /Note:/ This is not part of the public API!  It is exposed so that you can
    -- tinker with the internals of HUnit, but do not expect it to be stable!
      HUnitFailure (..)
    #endif
    )
    where

    -- When adapting this module for other Haskell language systems, change
    -- the imports and the implementations but not the interfaces.

    -- Imports
    -- -------

    #if defined(__GLASGOW_HASKELL__) || defined(__HUGS__)
    import Data.Dynamic
    import Control.Exception as E
    #else
    import Data.List (isPrefixOf)
    import System.IO.Error (ioeGetErrorString, try)
    #endif

    import Control.DeepSeq

    -- Interfaces
    -- ----------

    -- | When an assertion is evaluated, it will output a message if and only if the
    -- assertion fails.
    --
    -- Test cases are composed of a sequence of one or more assertions.

    type Assertion = IO ()

    -- | Unconditionally signals that a failure has occured.  All
    -- other assertions can be expressed with the form:
    --
    -- @
    --    if conditionIsMet
    --        then IO ()
    --        else assertFailure msg
    -- @

    assertFailure :: String -- ^ A message that is displayed with the assertion failure
                  -> Assertion

    -- | 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 -- ^ an assertion to be made during the test case run
                    -> IO (Maybe (Bool, String))

    -- Implementations
    -- ---------------

    #if defined(__GLASGOW_HASKELL__) || defined(__HUGS__)
    data HUnitFailure = HUnitFailure String
    #if __GLASGOW_HASKELL__ >= 707
        deriving (Show, Typeable)
    #else
        deriving Show

    hunitFailureTc :: TyCon
    #if MIN_VERSION_base(4,4,0)
    hunitFailureTc = mkTyCon3 "HUnit" "Test.HUnit.Lang" "HUnitFailure"
    #else
    hunitFailureTc = mkTyCon "HUnitFailure"
    #endif
    {-# NOINLINE hunitFailureTc #-}

    instance Typeable HUnitFailure where
        typeOf _ = mkTyConApp hunitFailureTc []
    #endif

    #ifdef BASE4
    instance Exception HUnitFailure

    assertFailure msg = msg `deepseq` E.throwIO (HUnitFailure msg)

    performTestCase action =
        do action
           return Nothing
         `E.catches`
          [E.Handler (\(HUnitFailure msg) -> return $ Just (True, msg)),

           -- Re-throw AsyncException, otherwise execution will not terminate on
           -- SIGINT (ctrl-c).  Currently, all AsyncExceptions are being thrown
           -- because it's thought that none of them will be encountered during
           -- normal HUnit operation.  If you encounter an example where this
           -- is not the case, please email the maintainer.
           E.Handler (\e -> throw (e :: E.AsyncException)),

           E.Handler (\e -> return $ Just (False, show (e :: E.SomeException)))]
    #else
    assertFailure msg = msg `deepseq` 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)
    #endif
    #else
    hunitPrefix = "HUnit:"

    nhc98Prefix = "I/O error (user-defined), call to function `userError':\n  "

    assertFailure msg = msg `deepseq` 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