{-|
Module      : Test.Tasty.Lua.Translate
Copyright   : © 2019-2024 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 = FilePath -> LuaE e (Either FilePath [ResultTree])
forall e.
LuaError e =>
FilePath -> LuaE e (Either FilePath [ResultTree])
runTastyFile FilePath
fp LuaE e (Either FilePath [ResultTree])
-> (Either FilePath [ResultTree] -> LuaE e TestTree)
-> LuaE e TestTree
forall a b. LuaE e a -> (a -> LuaE e b) -> LuaE e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Left FilePath
errMsg -> TestTree -> LuaE e TestTree
forall a. a -> LuaE e a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestTree -> LuaE e TestTree) -> TestTree -> LuaE e TestTree
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> TestTree
pathFailure FilePath
fp FilePath
errMsg
  Right [ResultTree]
tree  -> TestTree -> LuaE e TestTree
forall a. a -> LuaE e a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestTree -> LuaE e TestTree) -> TestTree -> LuaE e TestTree
forall a b. (a -> b) -> a -> b
$ FilePath -> [TestTree] -> TestTree
Tasty.testGroup FilePath
fp ((ResultTree -> TestTree) -> [ResultTree] -> [TestTree]
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 = FilePath -> MockTest -> TestTree
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 -> FilePath -> MockTest -> TestTree
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 ((ResultTree -> TestTree) -> [ResultTree] -> [TestTree]
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 ()
_ = Result -> IO Result
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Result -> IO Result) -> Result -> IO Result
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 = [OptionDescription] -> Tagged MockTest [OptionDescription]
forall a. a -> Tagged MockTest a
forall (m :: * -> *) a. Monad m => a -> m a
return []