{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Test.Tasty.Lua
(
pushModule
, testLuaFile
, translateResultsFromFile
, pathFailure
, registerArbitrary
)
where
import Control.Exception (SomeException, try)
import Data.Bifunctor (first)
import Data.List (intercalate)
import HsLua.Core (LuaE, LuaError)
import Test.Tasty (TestName, TestTree)
import Test.Tasty.Providers (IsTest (..), singleTest, testFailed, testPassed)
import Test.Tasty.Lua.Arbitrary (registerArbitrary)
import Test.Tasty.Lua.Module (pushModule)
import Test.Tasty.Lua.Core (Outcome (..), ResultTree (..), UnnamedTree (..),
runTastyFile)
import Test.Tasty.Lua.Translate (pathFailure, translateResultsFromFile)
testLuaFile :: forall e. LuaError e
=> (forall a. LuaE e a -> IO a)
-> TestName
-> FilePath
-> TestTree
testLuaFile :: forall e.
LuaError e =>
(forall a. LuaE e a -> IO a) -> TestName -> TestName -> TestTree
testLuaFile forall a. LuaE e a -> IO a
runLua TestName
name TestName
fp =
let testAction :: TestCase
testAction = IO ResultSummary -> TestCase
TestCase forall a b. (a -> b) -> a -> b
$ do
Either TestName [ResultTree]
eitherResult <- forall a. LuaE e a -> IO a
runLua (forall e.
LuaError e =>
TestName -> LuaE e (Either TestName [ResultTree])
runTastyFile @e TestName
fp)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Either TestName [ResultTree]
eitherResult of
Left TestName
errMsg -> [FailureInfo] -> ResultSummary
FailureSummary [([TestName
name], TestName
errMsg)]
Right [ResultTree]
result -> [ResultTree] -> ResultSummary
summarize [ResultTree]
result
in forall t. IsTest t => TestName -> t -> TestTree
singleTest TestName
name TestCase
testAction
newtype TestCase = TestCase (IO ResultSummary)
instance IsTest TestCase where
run :: OptionSet -> TestCase -> (Progress -> IO ()) -> IO Result
run OptionSet
_ (TestCase IO ResultSummary
action) Progress -> IO ()
_ = do
Either SomeException ResultSummary
result <- forall e a. Exception e => IO a -> IO (Either e a)
try IO ResultSummary
action
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Either SomeException ResultSummary
result of
Left SomeException
e -> TestName -> Result
testFailed (forall a. Show a => a -> TestName
show (SomeException
e :: SomeException))
Right ResultSummary
summary -> case ResultSummary
summary of
SuccessSummary Int
n ->
TestName -> Result
testPassed forall a b. (a -> b) -> a -> b
$ TestName
"+++ Success: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> TestName
show Int
n forall a. [a] -> [a] -> [a]
++ TestName
" Lua tests passed"
FailureSummary [FailureInfo]
fails ->
TestName -> Result
testFailed forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap FailureInfo -> TestName
stringifyFailureGist [FailureInfo]
fails
testOptions :: Tagged TestCase [OptionDescription]
testOptions = forall (m :: * -> *) a. Monad m => a -> m a
return []
summarize :: [ResultTree] -> ResultSummary
summarize :: [ResultTree] -> ResultSummary
summarize = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. Semigroup a => a -> a -> a
(<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResultTree -> ResultSummary
collectSummary) (Int -> ResultSummary
SuccessSummary Int
0)
type LuaErrorMessage = String
type FailureInfo = ([TestName], LuaErrorMessage)
data ResultSummary
= SuccessSummary Int
| FailureSummary [FailureInfo]
stringifyFailureGist :: FailureInfo -> String
stringifyFailureGist :: FailureInfo -> TestName
stringifyFailureGist ([TestName]
names, TestName
msg) =
forall a. [a] -> [[a]] -> [a]
intercalate TestName
" // " [TestName]
names forall a. [a] -> [a] -> [a]
++ TestName
":\n" forall a. [a] -> [a] -> [a]
++ TestName
msg forall a. [a] -> [a] -> [a]
++ TestName
"\n\n"
collectSummary :: ResultTree -> ResultSummary
collectSummary :: ResultTree -> ResultSummary
collectSummary (ResultTree TestName
name UnnamedTree
tree) =
case UnnamedTree
tree of
SingleTest Outcome
Success -> Int -> ResultSummary
SuccessSummary Int
1
SingleTest (Failure TestName
msg) -> [FailureInfo] -> ResultSummary
FailureSummary [([TestName
name], TestName
msg)]
TestGroup [ResultTree]
subtree -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (TestName -> ResultSummary -> ResultSummary
addGroup TestName
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResultTree -> ResultSummary
collectSummary)
[ResultTree]
subtree
addGroup :: TestName -> ResultSummary -> ResultSummary
addGroup :: TestName -> ResultSummary -> ResultSummary
addGroup TestName
name (FailureSummary [FailureInfo]
fs) = [FailureInfo] -> ResultSummary
FailureSummary (forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (TestName
nameforall a. a -> [a] -> [a]
:)) [FailureInfo]
fs)
addGroup TestName
_name ResultSummary
summary = ResultSummary
summary
instance Semigroup ResultSummary where
(SuccessSummary Int
n) <> :: ResultSummary -> ResultSummary -> ResultSummary
<> (SuccessSummary Int
m) = Int -> ResultSummary
SuccessSummary (Int
n forall a. Num a => a -> a -> a
+ Int
m)
(SuccessSummary Int
_) <> (FailureSummary [FailureInfo]
fs) = [FailureInfo] -> ResultSummary
FailureSummary [FailureInfo]
fs
(FailureSummary [FailureInfo]
fs) <> (SuccessSummary Int
_) = [FailureInfo] -> ResultSummary
FailureSummary [FailureInfo]
fs
(FailureSummary [FailureInfo]
fs) <> (FailureSummary [FailureInfo]
gs) = [FailureInfo] -> ResultSummary
FailureSummary ([FailureInfo]
fs forall a. [a] -> [a] -> [a]
++ [FailureInfo]
gs)
instance Monoid ResultSummary where
mempty :: ResultSummary
mempty = Int -> ResultSummary
SuccessSummary Int
0
mappend :: ResultSummary -> ResultSummary -> ResultSummary
mappend = forall a. Semigroup a => a -> a -> a
(<>)