{-|
Module      : Test.Tasty.Lua.Translate
Copyright   : © 2019-2023 Albert Krewinkel
License     : MIT
Maintainer  : Albert Krewinkel <tarleb@hslua.org>

Translate test results from Lua into a Tasty @'TestTree'@.
-}
module Test.Tasty.Lua.Translate
  ( translateResultsFromFile
  , pathFailure
  )
where

import HsLua.Core (LuaE, LuaError)
import Test.Tasty.Lua.Core (Outcome (..), ResultTree (..), UnnamedTree (..),
                            runTastyFile)
import qualified Test.Tasty as Tasty
import qualified Test.Tasty.Providers as Tasty

-- | Run tasty.lua tests from the given file and translate the result
-- into a mock Tasty @'TestTree'@.
translateResultsFromFile :: LuaError e => FilePath -> LuaE e Tasty.TestTree
translateResultsFromFile :: forall e. LuaError e => FilePath -> LuaE e TestTree
translateResultsFromFile FilePath
fp = forall e.
LuaError e =>
FilePath -> LuaE e (Either FilePath [ResultTree])
runTastyFile FilePath
fp forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Left FilePath
errMsg -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> TestTree
pathFailure FilePath
fp FilePath
errMsg
  Right [ResultTree]
tree  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ FilePath -> [TestTree] -> TestTree
Tasty.testGroup FilePath
fp (forall a b. (a -> b) -> [a] -> [b]
map ResultTree -> TestTree
testTree [ResultTree]
tree)

-- | Report failure of testing a path.
pathFailure :: FilePath -> String -> Tasty.TestTree
pathFailure :: FilePath -> FilePath -> TestTree
pathFailure FilePath
fp FilePath
errMsg = forall t. IsTest t => FilePath -> t -> TestTree
Tasty.singleTest FilePath
fp (Outcome -> MockTest
MockTest (FilePath -> Outcome
Failure FilePath
errMsg))

-- | Convert internal (tasty.lua) result tree format into Tasty tree.
testTree :: ResultTree -> Tasty.TestTree
testTree :: ResultTree -> TestTree
testTree (ResultTree FilePath
name UnnamedTree
tree) =
  case UnnamedTree
tree of
    SingleTest Outcome
outcome -> forall t. IsTest t => FilePath -> t -> TestTree
Tasty.singleTest FilePath
name (Outcome -> MockTest
MockTest Outcome
outcome)
    TestGroup [ResultTree]
results  -> FilePath -> [TestTree] -> TestTree
Tasty.testGroup FilePath
name (forall a b. (a -> b) -> [a] -> [b]
map ResultTree -> TestTree
testTree [ResultTree]
results)

-- | Mock test which just returns the predetermined outcome. An
-- @'Outcome'@ can be treated like a Tasty test, as it encodes all
-- necessary information. Usually, calling @'run'@ would trigger the
-- execution of the test, but in this case, the test has already been
-- run when the Lua script was executed.
newtype MockTest = MockTest Outcome

instance Tasty.IsTest MockTest where
  run :: OptionSet -> MockTest -> (Progress -> IO ()) -> IO Result
run OptionSet
_ (MockTest Outcome
outcome) Progress -> IO ()
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Outcome
outcome of
    Outcome
Success     -> FilePath -> Result
Tasty.testPassed FilePath
""
    Failure FilePath
msg -> FilePath -> Result
Tasty.testFailed FilePath
msg

  testOptions :: Tagged MockTest [OptionDescription]
testOptions = forall (m :: * -> *) a. Monad m => a -> m a
return []