{-# LANGUAGE FlexibleInstances #-}
module Test.Tasty.TLT (tltTest) where
import Control.Monad.IO.Class
import Data.Typeable
import Data.Tagged
import Test.TLT.Results (formatFail, totalFailCount)
import Test.TLT.Class
import qualified Test.Tasty.Providers as TTP
class MonadIO m => TastyTLT m where runOuter :: m a -> IO a
instance TastyTLT IO where runOuter :: IO a -> IO a
runOuter = IO a -> IO a
forall a. a -> a
id
instance (Typeable m, TastyTLT m) => TTP.IsTest (TLT m ()) where
run :: OptionSet -> TLT m () -> (Progress -> IO ()) -> IO Result
run OptionSet
options TLT m ()
tlt Progress -> IO ()
_ = do
(TLTopts
optsOut, [TestResult]
results) <- m (TLTopts, [TestResult]) -> IO (TLTopts, [TestResult])
forall (m :: * -> *) a. TastyTLT m => m a -> IO a
runOuter (m (TLTopts, [TestResult]) -> IO (TLTopts, [TestResult]))
-> m (TLTopts, [TestResult]) -> IO (TLTopts, [TestResult])
forall a b. (a -> b) -> a -> b
$ TLT m () -> m (TLTopts, [TestResult])
forall (m :: * -> *) r.
Monad m =>
TLT m r -> m (TLTopts, [TestResult])
runTLT TLT m ()
tlt
Result -> IO Result
forall (m :: * -> *) a. Monad m => a -> m a
return (Result -> IO Result) -> Result -> IO Result
forall a b. (a -> b) -> a -> b
$ case [TestResult] -> Int
totalFailCount [TestResult]
results of
Int
0 -> String -> Result
TTP.testPassed String
""
Int
_ -> String -> Result
TTP.testFailed
(Int -> String
forall a. Show a => a -> String
show ([TestResult] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TestResult]
results) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" errors found in TLT invocation")
testOptions :: Tagged (TLT m ()) [OptionDescription]
testOptions = [OptionDescription] -> Tagged (TLT m ()) [OptionDescription]
forall (m :: * -> *) a. Monad m => a -> m a
return []
tltTest :: String -> TLT IO () -> TTP.TestTree
tltTest :: String -> TLT IO () -> TestTree
tltTest = String -> TLT IO () -> TestTree
forall t. IsTest t => String -> t -> TestTree
TTP.singleTest