    {-# LANGUAGE CPP #-}
    {-# LANGUAGE DeriveDataTypeable #-}
    -- | Allows HUnit test cases to be used with the test-framework package.
    --
    -- For an example of how to use test-framework, please see <http://github.com/batterseapower/test-framework/raw/master/example/Test/Framework/Example.lhs>
    module Test.Framework.Providers.HUnit (
            testCase,
            hUnitTestToTests,
        ) where

    import Test.Framework.Providers.API

    import qualified Test.HUnit.Base
    import Test.HUnit.Lang

    import Data.Typeable

    -- | Create a 'Test' for a HUnit 'Assertion'
    testCase :: TestName -> Assertion -> Test
    testCase :: TestName -> Assertion -> Test
    testCase TestName
    name = TestName -> TestCase -> Test
    forall i r t. (Testlike i r t, Typeable t) => TestName -> t -> Test
    Test TestName
    name (TestCase -> Test) -> (Assertion -> TestCase) -> Assertion -> Test
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Assertion -> TestCase
    TestCase

    -- | Adapt an existing HUnit test into a list of test-framework tests.
    -- This is useful when migrating your existing HUnit test suite to test-framework.
    hUnitTestToTests :: Test.HUnit.Base.Test -> [Test]
    hUnitTestToTests :: Test -> [Test]
    hUnitTestToTests = TestName -> Test -> [Test]
    go TestName
    ""
      where
        go :: TestName -> Test -> [Test]
    go TestName
    desc (Test.HUnit.Base.TestCase Assertion
    a)    = [TestName -> Assertion -> Test
    testCase TestName
    desc Assertion
    a]
        go TestName
    desc (Test.HUnit.Base.TestLabel TestName
    s Test
    t) = TestName -> Test -> [Test]
    go (TestName
    desc TestName -> TestName -> TestName
    forall a. [a] -> [a] -> [a]
    ++ TestName
    ":" TestName -> TestName -> TestName
    forall a. [a] -> [a] -> [a]
    ++ TestName
    s) Test
    t
        go TestName
    desc (Test.HUnit.Base.TestList [Test]
    ts)
            -- If the list occurs at the top level (with no description above it),
            -- just return that list straightforwardly
          | TestName -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null TestName
    desc = (Test -> [Test]) -> [Test] -> [Test]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (TestName -> Test -> [Test]
    go TestName
    desc) [Test]
    ts
            -- If the list occurs with a description, turn that into a honest-to-god
            -- test group. This is heuristic, but likely to give good results
          | Bool
    otherwise = [TestName -> [Test] -> Test
    testGroup TestName
    desc ((Test -> [Test]) -> [Test] -> [Test]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (TestName -> Test -> [Test]
    go TestName
    "") [Test]
    ts)]

    instance TestResultlike TestCaseRunning TestCaseResult where
        testSucceeded :: TestCaseResult -> Bool
    testSucceeded = TestCaseResult -> Bool
    testCaseSucceeded

    data TestCaseRunning = TestCaseRunning

    instance Show TestCaseRunning where
        show :: TestCaseRunning -> TestName
    show TestCaseRunning
    TestCaseRunning = TestName
    "Running"

    data TestCaseResult = TestCasePassed
                        | TestCaseFailed String
                        | TestCaseError String

    instance Show TestCaseResult where
        show :: TestCaseResult -> TestName
    show TestCaseResult
    result = case TestCaseResult
    result of
            TestCaseResult
    TestCasePassed         -> TestName
    "OK"
            TestCaseFailed TestName
    message -> TestName
    message
            TestCaseError TestName
    message  -> TestName
    "ERROR: " TestName -> TestName -> TestName
    forall a. [a] -> [a] -> [a]
    ++ TestName
    message

    testCaseSucceeded :: TestCaseResult -> Bool
    testCaseSucceeded :: TestCaseResult -> Bool
    testCaseSucceeded TestCaseResult
    TestCasePassed = Bool
    True
    testCaseSucceeded TestCaseResult
    _              = Bool
    False

    newtype TestCase = TestCase Assertion
        deriving Typeable

    instance Testlike TestCaseRunning TestCaseResult TestCase where
        runTest :: CompleteTestOptions
    -> TestCase -> IO (TestCaseRunning :~> TestCaseResult, Assertion)
    runTest CompleteTestOptions
    topts (TestCase Assertion
    assertion) = CompleteTestOptions
    -> Assertion -> IO (TestCaseRunning :~> TestCaseResult, Assertion)
    runTestCase CompleteTestOptions
    topts Assertion
    assertion
        testTypeName :: TestCase -> TestName
    testTypeName TestCase
    _ = TestName
    "Test Cases"

    runTestCase :: CompleteTestOptions -> Assertion -> IO (TestCaseRunning :~> TestCaseResult, IO ())
    runTestCase :: CompleteTestOptions
    -> Assertion -> IO (TestCaseRunning :~> TestCaseResult, Assertion)
    runTestCase CompleteTestOptions
    topts Assertion
    assertion = ImprovingIO TestCaseRunning TestCaseResult TestCaseResult
    -> IO (TestCaseRunning :~> TestCaseResult, Assertion)
    forall i f. ImprovingIO i f f -> IO (i :~> f, Assertion)
    runImprovingIO (ImprovingIO TestCaseRunning TestCaseResult TestCaseResult
     -> IO (TestCaseRunning :~> TestCaseResult, Assertion))
    -> ImprovingIO TestCaseRunning TestCaseResult TestCaseResult
    -> IO (TestCaseRunning :~> TestCaseResult, Assertion)
    forall a b. (a -> b) -> a -> b
    $ do
        TestCaseRunning -> ImprovingIO TestCaseRunning TestCaseResult ()
    forall i f. i -> ImprovingIO i f ()
    yieldImprovement TestCaseRunning
    TestCaseRunning
        mb_result <- Maybe Int
    -> ImprovingIO TestCaseRunning TestCaseResult TestCaseResult
    -> ImprovingIO
         TestCaseRunning TestCaseResult (Maybe TestCaseResult)
    forall i f a.
    Maybe Int -> ImprovingIO i f a -> ImprovingIO i f (Maybe a)
    maybeTimeoutImprovingIO (K (Maybe Int) -> Maybe Int
    forall a. K a -> a
    unK (K (Maybe Int) -> Maybe Int) -> K (Maybe Int) -> Maybe Int
    forall a b. (a -> b) -> a -> b
    $ CompleteTestOptions -> K (Maybe Int)
    forall (f :: * -> *). TestOptions' f -> f (Maybe Int)
    topt_timeout CompleteTestOptions
    topts) (ImprovingIO TestCaseRunning TestCaseResult TestCaseResult
     -> ImprovingIO
          TestCaseRunning TestCaseResult (Maybe TestCaseResult))
    -> ImprovingIO TestCaseRunning TestCaseResult TestCaseResult
    -> ImprovingIO
         TestCaseRunning TestCaseResult (Maybe TestCaseResult)
    forall a b. (a -> b) -> a -> b
    $ IO TestCaseResult
    -> ImprovingIO TestCaseRunning TestCaseResult TestCaseResult
    forall a i f. IO a -> ImprovingIO i f a
    liftIO (Assertion -> IO TestCaseResult
    myPerformTestCase Assertion
    assertion)
        return (mb_result `orElse` TestCaseError "Timed out")

    myPerformTestCase :: Assertion -> IO TestCaseResult
    myPerformTestCase :: Assertion -> IO TestCaseResult
    myPerformTestCase Assertion
    assertion = do
        result <- Assertion -> IO Result
    performTestCase Assertion
    assertion
        return $ case result of
    #if MIN_VERSION_HUnit(1,3,0)
            Result
    Success               -> TestCaseResult
    TestCasePassed
            Failure Maybe SrcLoc
    _loc TestName
    message  -> TestName -> TestCaseResult
    TestCaseFailed TestName
    message
            Error   Maybe SrcLoc
    _loc TestName
    message  -> TestName -> TestCaseResult
    TestCaseError TestName
    message
    #else
            Nothing               -> TestCasePassed
            Just (True, message)  -> TestCaseFailed message
            Just (False, message) -> TestCaseError message
    #endif