{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-|
Module      : Test.Tasty.Lua.Core
Copyright   : © 2019-2023 Albert Krewinkel
License     : MIT
Maintainer  : Albert Krewinkel <tarleb@hslua.org>

Core types and functions for tasty Lua tests.
-}
module Test.Tasty.Lua.Core
  ( runTastyFile
  , ResultTree (..)
  , Outcome (..)
  , UnnamedTree (..)
  )
where

import Control.Monad ((<$!>), void)
import HsLua.Core (LuaE, LuaError, pop, toboolean, top)
import HsLua.Marshalling
  ( Peeker, lastly, liftLua, resultToEither, retrieving
  , peekFieldRaw, peekList, peekString, runPeek)
import Test.Tasty.Lua.Module (pushModule)
import qualified HsLua.Core as Lua
import qualified HsLua.Core.Utf8 as Utf8
import qualified Test.Tasty as Tasty

-- | Run a tasty Lua script from a file and return either the resulting
-- test tree or the error message.
runTastyFile :: LuaError e => FilePath -> LuaE e (Either String [ResultTree])
runTastyFile :: forall e.
LuaError e =>
FilePath -> LuaE e (Either FilePath [ResultTree])
runTastyFile FilePath
fp = do
  forall e. LuaE e ()
Lua.openlibs
  forall e. LuaError e => Name -> (Name -> LuaE e ()) -> LuaE e ()
Lua.requirehs Name
"tasty" (forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e. LuaError e => HaskellFunction e
pushModule)
  Status
res <- forall e. Maybe FilePath -> LuaE e Status
Lua.dofileTrace (forall a. a -> Maybe a
Just FilePath
fp)
  if Status
res forall a. Eq a => a -> a -> Bool
/= Status
Lua.OK
    then forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> FilePath
Utf8.toString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. LuaError e => StackIndex -> LuaE e ByteString
Lua.tostring' StackIndex
top
    else forall a. Result a -> Either FilePath a
resultToEither forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e a. Peek e a -> LuaE e (Result a)
runPeek (forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList forall e. LuaError e => Peeker e ResultTree
peekResultTree StackIndex
top)

-- | Tree of test results returned by tasty Lua scripts. This is
-- similar to tasty's @'TestTree'@, with the important difference that
-- all tests have already been run, and all test results are known.
data ResultTree = ResultTree Tasty.TestName UnnamedTree

peekResultTree :: LuaError e => Peeker e ResultTree
peekResultTree :: forall e. LuaError e => Peeker e ResultTree
peekResultTree StackIndex
idx = do
  FilePath
name   <- forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw forall e. Peeker e FilePath
peekString Name
"name" StackIndex
idx
  UnnamedTree
result <- forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw forall e. LuaError e => Peeker e UnnamedTree
peekUnnamedTree Name
"result" StackIndex
idx
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! FilePath -> UnnamedTree -> ResultTree
ResultTree FilePath
name UnnamedTree
result

-- | Either a raw test outcome, or a nested @'Tree'@.
data UnnamedTree
  = SingleTest Outcome
  | TestGroup [ResultTree]

-- | Unmarshal an @'UnnamedTree'@.
peekUnnamedTree :: LuaError e => Peeker e UnnamedTree
peekUnnamedTree :: forall e. LuaError e => Peeker e UnnamedTree
peekUnnamedTree StackIndex
idx = forall e a. LuaE e a -> Peek e a
liftLua (forall e. StackIndex -> LuaE e Type
Lua.ltype StackIndex
idx) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Type
Lua.TypeTable -> [ResultTree] -> UnnamedTree
TestGroup   forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList forall e. LuaError e => Peeker e ResultTree
peekResultTree StackIndex
idx
  Type
_             -> Outcome -> UnnamedTree
SingleTest  forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall e. LuaError e => Peeker e Outcome
peekOutcome StackIndex
idx


-- | Test outcome
data Outcome = Success | Failure String

-- | Unmarshal a test outcome
peekOutcome :: LuaError e => Peeker e Outcome
peekOutcome :: forall e. LuaError e => Peeker e Outcome
peekOutcome StackIndex
idx = forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"test result" forall a b. (a -> b) -> a -> b
$ do
  forall e a. LuaE e a -> Peek e a
liftLua (forall e. StackIndex -> LuaE e Type
Lua.ltype StackIndex
idx) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Type
Lua.TypeString  -> FilePath -> Outcome
Failure forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall e. Peeker e FilePath
peekString StackIndex
idx
    Type
Lua.TypeBoolean -> do
      Bool
b <- forall e a. LuaE e a -> Peek e a
liftLua forall a b. (a -> b) -> a -> b
$ forall e. StackIndex -> LuaE e Bool
toboolean StackIndex
idx
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Bool
b then Outcome
Success else FilePath -> Outcome
Failure FilePath
"???"
    Type
_ -> FilePath -> Outcome
Failure forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!>
         (forall e a. LuaE e a -> Peek e a
liftLua (forall e. LuaError e => StackIndex -> LuaE e ByteString
Lua.tostring' StackIndex
idx) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e. Peeker e FilePath
peekString StackIndex
top) forall e a b. Peek e a -> LuaE e b -> Peek e a
`lastly` forall e. Int -> LuaE e ()
pop Int
1