    {-# LANGUAGE UndecidableInstances, DeriveDataTypeable #-}
    module Test.Framework.Core where

    import Test.Framework.Improving
    import Test.Framework.Options

    import Control.Arrow (first, second)
    import Control.Concurrent.MVar ( withMVar, newMVar, MVar )
    import Data.Typeable ( Typeable )

    -- | Something like the result of a test: works in concert with 'Testlike'.
    -- The type parameters are the type that is used for progress reports and the
    -- type of the final output of the test respectively.
    class (Show i, Show r) => TestResultlike i r | r -> i where
        testSucceeded :: r -> Bool

    -- | Something test-like in its behaviour. The type parameters are the type that
    -- is used for progress reports, the type of the final output of the test and the
    -- data type encapsulating the whole potential to do a test respectively.
    class TestResultlike i r => Testlike i r t | t -> i r, r -> i where
        runTest :: CompleteTestOptions -> t -> IO (i :~> r, IO ())
        testTypeName :: t -> TestTypeName

    -- | Test names or descriptions. These are shown to the user
    type TestName = String

    -- | The name of a type of test, such as "Properties" or "Test Cases". Tests of
    -- types of the same names will be grouped together in the test run summary.
    type TestTypeName = String

    -- | Main test data type: builds up a list of tests to be run. Users should use the
    -- utility functions in e.g. the test-framework-hunit and test-framework-quickcheck2
    -- packages to create instances of 'Test', and then build them up into testsuites
    -- by using 'testGroup' and lists.
    --
    -- For an example of how to use test-framework, please see
    -- <http://github.com/batterseapower/test-framework/raw/master/example/Test/Framework/Example.lhs>
    data Test = forall i r t.
                (Testlike i r t, Typeable t) => Test TestName t -- ^ A single test of some particular type
              | TestGroup TestName [Test]                       -- ^ Assemble a number of tests into a cohesive group
              | PlusTestOptions TestOptions Test                -- ^ Add some options to child tests
              | BuildTestBracketed (IO (Test, IO ()))           -- ^ Convenience for creating tests from an 'IO' action, with cleanup

    -- | Assemble a number of tests into a cohesive group
    testGroup :: TestName -> [Test] -> Test
    testGroup :: TestName -> [Test] -> Test
    testGroup = TestName -> [Test] -> Test
    TestGroup

    -- | Add some options to child tests
    plusTestOptions :: TestOptions -> Test -> Test
    plusTestOptions :: TestOptions -> Test -> Test
    plusTestOptions = TestOptions -> Test -> Test
    PlusTestOptions

    -- | Convenience for creating tests from an 'IO' action
    buildTest :: IO Test -> Test
    buildTest :: IO Test -> Test
    buildTest IO Test
    mx = IO (Test, IO ()) -> Test
    BuildTestBracketed ((Test -> (Test, IO ())) -> IO Test -> IO (Test, IO ())
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Test -> IO () -> (Test, IO ())) -> IO () -> Test -> (Test, IO ())
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (,) (() -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())) IO Test
    mx)

    -- | Convenience for creating tests from an 'IO' action, with a cleanup handler for when tests are finished
    buildTestBracketed :: IO (Test, IO ()) -> Test
    buildTestBracketed :: IO (Test, IO ()) -> Test
    buildTestBracketed = IO (Test, IO ()) -> Test
    BuildTestBracketed

    data MutuallyExcluded t = ME (MVar ()) t
        deriving Typeable

    -- This requires UndecidableInstances, but I think it can't be made inconsistent?
    instance Testlike i r t => Testlike i r (MutuallyExcluded t) where
        runTest :: CompleteTestOptions -> MutuallyExcluded t -> IO (i :~> r, IO ())
    runTest CompleteTestOptions
    cto (ME MVar ()
    mvar t
    x) = ((i :~> r, IO ()) -> (i :~> r, IO ()))
    -> IO (i :~> r, IO ()) -> IO (i :~> r, IO ())
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((IO () -> IO ()) -> (i :~> r, IO ()) -> (i :~> r, IO ())
    forall b c d. (b -> c) -> (d, b) -> (d, c)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (d, b) (d, c)
    second (\IO ()
    act -> MVar () -> (() -> IO ()) -> IO ()
    forall a b. MVar a -> (a -> IO b) -> IO b
    withMVar MVar ()
    mvar ((() -> IO ()) -> IO ()) -> (() -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \() -> IO ()
    act)) (IO (i :~> r, IO ()) -> IO (i :~> r, IO ()))
    -> IO (i :~> r, IO ()) -> IO (i :~> r, IO ())
    forall a b. (a -> b) -> a -> b
    $ CompleteTestOptions -> t -> IO (i :~> r, IO ())
    forall i r t.
    Testlike i r t =>
    CompleteTestOptions -> t -> IO (i :~> r, IO ())
    runTest CompleteTestOptions
    cto t
    x
        testTypeName :: MutuallyExcluded t -> TestName
    testTypeName ~(ME MVar ()
    _ t
    x) = t -> TestName
    forall i r t. Testlike i r t => t -> TestName
    testTypeName t
    x

    -- | Mark all tests in this portion of the tree as mutually exclusive, so only one runs at a time
    {-# NOINLINE mutuallyExclusive #-}
    mutuallyExclusive :: Test -> Test
    mutuallyExclusive :: Test -> Test
    mutuallyExclusive Test
    init_t = IO Test -> Test
    buildTest (IO Test -> Test) -> IO Test -> Test
    forall a b. (a -> b) -> a -> b
    $ do
        mvar <- () -> IO (MVar ())
    forall a. a -> IO (MVar a)
    newMVar ()
        let go (Test TestName
    tn t
    t)                = TestName -> MutuallyExcluded t -> Test
    forall i r t. (Testlike i r t, Typeable t) => TestName -> t -> Test
    Test TestName
    tn (MVar () -> t -> MutuallyExcluded t
    forall t. MVar () -> t -> MutuallyExcluded t
    ME MVar ()
    mvar t
    t)
            go (TestGroup TestName
    tn [Test]
    ts)          = TestName -> [Test] -> Test
    TestGroup TestName
    tn ((Test -> Test) -> [Test] -> [Test]
    forall a b. (a -> b) -> [a] -> [b]
    map Test -> Test
    go [Test]
    ts)
            go (PlusTestOptions TestOptions
    to Test
    t)     = TestOptions -> Test -> Test
    PlusTestOptions TestOptions
    to (Test -> Test
    go Test
    t)
            go (BuildTestBracketed IO (Test, IO ())
    build) = IO (Test, IO ()) -> Test
    BuildTestBracketed (((Test, IO ()) -> (Test, IO ()))
    -> IO (Test, IO ()) -> IO (Test, IO ())
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Test -> Test) -> (Test, IO ()) -> (Test, IO ())
    forall b c d. (b -> c) -> (b, d) -> (c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first Test -> Test
    go) IO (Test, IO ())
    build)
        return (go init_t)