{-# LANGUAGE LambdaCase #-}
module Test.Tasty.Lua.Core
( runTastyFile
, ResultTree (..)
, Outcome (..)
, UnnamedTree (..)
)
where
import Control.Monad (void)
import Data.ByteString (ByteString)
import Foreign.Lua (Lua, Peekable, StackIndex)
import Test.Tasty.Lua.Module (pushModule)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text.Encoding
import qualified Foreign.Lua as Lua
import qualified Test.Tasty as Tasty
runTastyFile :: FilePath -> Lua (Either String [ResultTree])
runTastyFile :: FilePath -> Lua (Either FilePath [ResultTree])
runTastyFile FilePath
fp = do
Lua ()
Lua.openlibs
FilePath -> Lua () -> Lua ()
Lua.requirehs FilePath
"tasty" (Lua NumResults -> Lua ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Lua NumResults
pushModule)
Status
res <- FilePath -> Lua Status
Lua.dofile FilePath
fp
if Status
res Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
/= Status
Lua.OK
then FilePath -> Either FilePath [ResultTree]
forall a b. a -> Either a b
Left (FilePath -> Either FilePath [ResultTree])
-> (ByteString -> FilePath)
-> ByteString
-> Either FilePath [ResultTree]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> FilePath
toString (ByteString -> Either FilePath [ResultTree])
-> Lua ByteString -> Lua (Either FilePath [ResultTree])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StackIndex -> Lua ByteString
Lua.tostring' StackIndex
Lua.stackTop
else Lua [ResultTree] -> Lua (Either Exception [ResultTree])
forall a. Lua a -> Lua (Either Exception a)
Lua.try (StackIndex -> Lua [ResultTree]
forall a. Peekable a => StackIndex -> Lua [a]
Lua.peekList StackIndex
Lua.stackTop) Lua (Either Exception [ResultTree])
-> (Either Exception [ResultTree]
-> Lua (Either FilePath [ResultTree]))
-> Lua (Either FilePath [ResultTree])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left (Lua.Exception FilePath
e) -> Either FilePath [ResultTree] -> Lua (Either FilePath [ResultTree])
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Either FilePath [ResultTree]
forall a b. a -> Either a b
Left FilePath
e)
Right [ResultTree]
trees -> Either FilePath [ResultTree] -> Lua (Either FilePath [ResultTree])
forall (m :: * -> *) a. Monad m => a -> m a
return ([ResultTree] -> Either FilePath [ResultTree]
forall a b. b -> Either a b
Right [ResultTree]
trees)
toString :: ByteString -> String
toString :: ByteString -> FilePath
toString = Text -> FilePath
Text.unpack (Text -> FilePath)
-> (ByteString -> Text) -> ByteString -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Text.Encoding.decodeUtf8
data ResultTree = ResultTree Tasty.TestName UnnamedTree
instance Peekable ResultTree where
peek :: StackIndex -> Lua ResultTree
peek = StackIndex -> Lua ResultTree
peekResultTree
peekResultTree :: StackIndex -> Lua ResultTree
peekResultTree :: StackIndex -> Lua ResultTree
peekResultTree StackIndex
idx = do
FilePath
name <- StackIndex -> FilePath -> Lua ()
Lua.getfield StackIndex
idx FilePath
"name" Lua () -> Lua FilePath -> Lua FilePath
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Lua FilePath
forall a. Peekable a => Lua a
Lua.popValue
UnnamedTree
result <- StackIndex -> FilePath -> Lua ()
Lua.getfield StackIndex
idx FilePath
"result" Lua () -> Lua UnnamedTree -> Lua UnnamedTree
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Lua UnnamedTree
forall a. Peekable a => Lua a
Lua.popValue
ResultTree -> Lua ResultTree
forall (m :: * -> *) a. Monad m => a -> m a
return (ResultTree -> Lua ResultTree) -> ResultTree -> Lua ResultTree
forall a b. (a -> b) -> a -> b
$ FilePath -> UnnamedTree -> ResultTree
ResultTree FilePath
name UnnamedTree
result
data UnnamedTree
= SingleTest Outcome
| TestGroup [ResultTree]
instance Peekable UnnamedTree where
peek :: StackIndex -> Lua UnnamedTree
peek = StackIndex -> Lua UnnamedTree
peekUnnamedTree
peekUnnamedTree :: StackIndex -> Lua UnnamedTree
peekUnnamedTree :: StackIndex -> Lua UnnamedTree
peekUnnamedTree StackIndex
idx = do
Type
ty <- StackIndex -> Lua Type
Lua.ltype StackIndex
idx
case Type
ty of
Type
Lua.TypeTable -> [ResultTree] -> UnnamedTree
TestGroup ([ResultTree] -> UnnamedTree)
-> Lua [ResultTree] -> Lua UnnamedTree
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StackIndex -> Lua [ResultTree]
forall a. Peekable a => StackIndex -> Lua [a]
Lua.peekList StackIndex
idx
Type
_ -> Outcome -> UnnamedTree
SingleTest (Outcome -> UnnamedTree) -> Lua Outcome -> Lua UnnamedTree
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StackIndex -> Lua Outcome
forall a. Peekable a => StackIndex -> Lua a
Lua.peek StackIndex
idx
data Outcome = Success | Failure String
instance Peekable Outcome where
peek :: StackIndex -> Lua Outcome
peek = StackIndex -> Lua Outcome
peekOutcome
peekOutcome :: StackIndex -> Lua Outcome
peekOutcome :: StackIndex -> Lua Outcome
peekOutcome StackIndex
idx = do
Type
ty <- StackIndex -> Lua Type
Lua.ltype StackIndex
idx
case Type
ty of
Type
Lua.TypeString -> FilePath -> Outcome
Failure (FilePath -> Outcome) -> Lua FilePath -> Lua Outcome
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StackIndex -> Lua FilePath
forall a. Peekable a => StackIndex -> Lua a
Lua.peek StackIndex
idx
Type
Lua.TypeBoolean -> do
Bool
b <- StackIndex -> Lua Bool
forall a. Peekable a => StackIndex -> Lua a
Lua.peek StackIndex
idx
Outcome -> Lua Outcome
forall (m :: * -> *) a. Monad m => a -> m a
return (Outcome -> Lua Outcome) -> Outcome -> Lua Outcome
forall a b. (a -> b) -> a -> b
$ if Bool
b then Outcome
Success else FilePath -> Outcome
Failure FilePath
"???"
Type
_ -> do
FilePath
s <- ByteString -> FilePath
toString (ByteString -> FilePath) -> Lua ByteString -> Lua FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StackIndex -> Lua ByteString
Lua.tostring' StackIndex
idx
FilePath -> Lua Outcome
forall a. FilePath -> Lua a
Lua.throwException (FilePath
"not a test result: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
s)