{-# LANGUAGE GeneralizedNewtypeDeriving, PatternGuards, DeriveDataTypeable #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RankNTypes #-}
module Test.Tasty.Silver.Interactive.Run
  ( wrapRunTest
  )
  where

import Data.Tagged
import Data.Typeable

import Test.Tasty hiding (defaultMain)
import Test.Tasty.Options
import Test.Tasty.Providers
import Test.Tasty.Runners
import Test.Tasty.Silver.Filter ( TestPath )

data CustomTestExec t = IsTest t => CustomTestExec t (OptionSet -> t -> (Progress -> IO ()) -> IO Result)
  deriving (Typeable)

instance IsTest t => IsTest (CustomTestExec t) where
  run :: OptionSet -> CustomTestExec t -> (Progress -> IO ()) -> IO Result
run OptionSet
opts (CustomTestExec t
t OptionSet -> t -> (Progress -> IO ()) -> IO Result
r) Progress -> IO ()
cb = OptionSet -> t -> (Progress -> IO ()) -> IO Result
r OptionSet
opts t
t Progress -> IO ()
cb
  testOptions :: Tagged (CustomTestExec t) [OptionDescription]
testOptions = Tagged t [OptionDescription]
-> Tagged (CustomTestExec t) [OptionDescription]
forall {k1} {k2} (s :: k1) b (t :: k2). Tagged s b -> Tagged t b
retag (Tagged t [OptionDescription]
 -> Tagged (CustomTestExec t) [OptionDescription])
-> Tagged t [OptionDescription]
-> Tagged (CustomTestExec t) [OptionDescription]
forall a b. (a -> b) -> a -> b
$ (Tagged t [OptionDescription]
forall t. IsTest t => Tagged t [OptionDescription]
testOptions :: Tagged t [OptionDescription])

-- | Provide new test run function wrapping the existing tests.
wrapRunTest
    :: (forall t . IsTest t => TestPath -> TestName -> OptionSet -> t -> (Progress -> IO ()) -> IO Result)
    -> TestTree
    -> TestTree
wrapRunTest :: (forall t.
 IsTest t =>
 TestPath
 -> TestPath -> OptionSet -> t -> (Progress -> IO ()) -> IO Result)
-> TestTree -> TestTree
wrapRunTest = TestPath
-> (forall t.
    IsTest t =>
    TestPath
    -> TestPath -> OptionSet -> t -> (Progress -> IO ()) -> IO Result)
-> TestTree
-> TestTree
wrapRunTest' TestPath
"/"

wrapRunTest' :: TestPath
    -> (forall t . IsTest t => TestPath -> TestName -> OptionSet -> t -> (Progress -> IO ()) -> IO Result)
    -> TestTree
    -> TestTree
wrapRunTest' :: TestPath
-> (forall t.
    IsTest t =>
    TestPath
    -> TestPath -> OptionSet -> t -> (Progress -> IO ()) -> IO Result)
-> TestTree
-> TestTree
wrapRunTest' TestPath
tp forall t.
IsTest t =>
TestPath
-> TestPath -> OptionSet -> t -> (Progress -> IO ()) -> IO Result
f (SingleTest TestPath
n t
t) = TestPath -> CustomTestExec t -> TestTree
forall t. IsTest t => TestPath -> t -> TestTree
SingleTest TestPath
n (t
-> (OptionSet -> t -> (Progress -> IO ()) -> IO Result)
-> CustomTestExec t
forall t.
IsTest t =>
t
-> (OptionSet -> t -> (Progress -> IO ()) -> IO Result)
-> CustomTestExec t
CustomTestExec t
t (TestPath
-> TestPath -> OptionSet -> t -> (Progress -> IO ()) -> IO Result
forall t.
IsTest t =>
TestPath
-> TestPath -> OptionSet -> t -> (Progress -> IO ()) -> IO Result
f (TestPath
tp TestPath -> TestPath -> TestPath
<//> TestPath
n) TestPath
n))
wrapRunTest' TestPath
tp forall t.
IsTest t =>
TestPath
-> TestPath -> OptionSet -> t -> (Progress -> IO ()) -> IO Result
f (TestGroup TestPath
n [TestTree]
ts) = TestPath -> [TestTree] -> TestTree
TestGroup TestPath
n ((TestTree -> TestTree) -> [TestTree] -> [TestTree]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TestPath
-> (forall t.
    IsTest t =>
    TestPath
    -> TestPath -> OptionSet -> t -> (Progress -> IO ()) -> IO Result)
-> TestTree
-> TestTree
wrapRunTest' (TestPath
tp TestPath -> TestPath -> TestPath
<//> TestPath
n) TestPath
-> TestPath -> OptionSet -> t -> (Progress -> IO ()) -> IO Result
forall t.
IsTest t =>
TestPath
-> TestPath -> OptionSet -> t -> (Progress -> IO ()) -> IO Result
f) [TestTree]
ts)
wrapRunTest' TestPath
tp forall t.
IsTest t =>
TestPath
-> TestPath -> OptionSet -> t -> (Progress -> IO ()) -> IO Result
f (PlusTestOptions OptionSet -> OptionSet
o TestTree
t) = (OptionSet -> OptionSet) -> TestTree -> TestTree
PlusTestOptions OptionSet -> OptionSet
o (TestPath
-> (forall t.
    IsTest t =>
    TestPath
    -> TestPath -> OptionSet -> t -> (Progress -> IO ()) -> IO Result)
-> TestTree
-> TestTree
wrapRunTest' TestPath
tp TestPath
-> TestPath -> OptionSet -> t -> (Progress -> IO ()) -> IO Result
forall t.
IsTest t =>
TestPath
-> TestPath -> OptionSet -> t -> (Progress -> IO ()) -> IO Result
f TestTree
t)
wrapRunTest' TestPath
tp forall t.
IsTest t =>
TestPath
-> TestPath -> OptionSet -> t -> (Progress -> IO ()) -> IO Result
f (WithResource ResourceSpec a
r IO a -> TestTree
t) = ResourceSpec a -> (IO a -> TestTree) -> TestTree
forall a. ResourceSpec a -> (IO a -> TestTree) -> TestTree
WithResource ResourceSpec a
r (\IO a
x -> TestPath
-> (forall t.
    IsTest t =>
    TestPath
    -> TestPath -> OptionSet -> t -> (Progress -> IO ()) -> IO Result)
-> TestTree
-> TestTree
wrapRunTest' TestPath
tp TestPath
-> TestPath -> OptionSet -> t -> (Progress -> IO ()) -> IO Result
forall t.
IsTest t =>
TestPath
-> TestPath -> OptionSet -> t -> (Progress -> IO ()) -> IO Result
f (IO a -> TestTree
t IO a
x))
wrapRunTest' TestPath
tp forall t.
IsTest t =>
TestPath
-> TestPath -> OptionSet -> t -> (Progress -> IO ()) -> IO Result
f (AskOptions OptionSet -> TestTree
t) = (OptionSet -> TestTree) -> TestTree
AskOptions (\OptionSet
o -> TestPath
-> (forall t.
    IsTest t =>
    TestPath
    -> TestPath -> OptionSet -> t -> (Progress -> IO ()) -> IO Result)
-> TestTree
-> TestTree
wrapRunTest' TestPath
tp TestPath
-> TestPath -> OptionSet -> t -> (Progress -> IO ()) -> IO Result
forall t.
IsTest t =>
TestPath
-> TestPath -> OptionSet -> t -> (Progress -> IO ()) -> IO Result
f (OptionSet -> TestTree
t OptionSet
o))

(<//>) :: TestPath -> TestPath -> TestPath
TestPath
a <//> :: TestPath -> TestPath -> TestPath
<//> TestPath
b = TestPath
a TestPath -> TestPath -> TestPath
forall a. [a] -> [a] -> [a]
++ TestPath
"/" TestPath -> TestPath -> TestPath
forall a. [a] -> [a] -> [a]
++ TestPath
b