{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-|
Module      : Test.Tasty.Lua.Core
Copyright   : © 2019–2022 Albert Krewinkel
License     : MIT
Maintainer  : Albert Krewinkel <albert+hslua@zeitkraut.de>

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, toboolean, top)
import HsLua.Marshalling
  ( Peeker, failPeek, liftLua, resultToEither, retrieving
  , peekFieldRaw, peekList, peekString, runPeek, typeMismatchMessage)
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 :: FilePath -> LuaE e (Either FilePath [ResultTree])
runTastyFile FilePath
fp = do
  LuaE e ()
forall e. LuaE e ()
Lua.openlibs
  Name -> (Name -> LuaE e ()) -> LuaE e ()
forall e. LuaError e => Name -> (Name -> LuaE e ()) -> LuaE e ()
Lua.requirehs Name
"tasty" (LuaE e () -> Name -> LuaE e ()
forall a b. a -> b -> a
const (LuaE e () -> Name -> LuaE e ())
-> (LuaE e NumResults -> LuaE e ())
-> LuaE e NumResults
-> Name
-> LuaE e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LuaE e NumResults -> LuaE e ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (LuaE e NumResults -> Name -> LuaE e ())
-> LuaE e NumResults -> Name -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ LuaE e NumResults
forall e. LuaError e => HaskellFunction e
pushModule)
  Status
res <- FilePath -> LuaE e Status
forall e. FilePath -> LuaE e Status
Lua.dofileTrace 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
Utf8.toString (ByteString -> Either FilePath [ResultTree])
-> LuaE e ByteString -> LuaE e (Either FilePath [ResultTree])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StackIndex -> LuaE e ByteString
forall e. LuaError e => StackIndex -> LuaE e ByteString
Lua.tostring' StackIndex
top
    else Result [ResultTree] -> Either FilePath [ResultTree]
forall a. Result a -> Either FilePath a
resultToEither (Result [ResultTree] -> Either FilePath [ResultTree])
-> LuaE e (Result [ResultTree])
-> LuaE e (Either FilePath [ResultTree])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Peek e [ResultTree] -> LuaE e (Result [ResultTree])
forall e a. Peek e a -> LuaE e (Result a)
runPeek (Peeker e ResultTree -> Peeker e [ResultTree]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e ResultTree
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 :: Peeker e ResultTree
peekResultTree StackIndex
idx = do
  FilePath
name   <- Peeker e FilePath -> Name -> Peeker e FilePath
forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw Peeker e FilePath
forall e. Peeker e FilePath
peekString Name
"name" StackIndex
idx
  UnnamedTree
result <- Peeker e UnnamedTree -> Name -> Peeker e UnnamedTree
forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw Peeker e UnnamedTree
forall e. LuaError e => Peeker e UnnamedTree
peekUnnamedTree Name
"result" StackIndex
idx
  ResultTree -> Peek e ResultTree
forall (m :: * -> *) a. Monad m => a -> m a
return (ResultTree -> Peek e ResultTree)
-> ResultTree -> Peek e ResultTree
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 :: Peeker e UnnamedTree
peekUnnamedTree StackIndex
idx = LuaE e Type -> Peek e Type
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> LuaE e Type
forall e. StackIndex -> LuaE e Type
Lua.ltype StackIndex
idx) Peek e Type -> (Type -> Peek e UnnamedTree) -> Peek e UnnamedTree
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Type
Lua.TypeTable -> [ResultTree] -> UnnamedTree
TestGroup   ([ResultTree] -> UnnamedTree)
-> Peek e [ResultTree] -> Peek e UnnamedTree
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e ResultTree -> Peeker e [ResultTree]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e ResultTree
forall e. LuaError e => Peeker e ResultTree
peekResultTree StackIndex
idx
  Type
_             -> Outcome -> UnnamedTree
SingleTest  (Outcome -> UnnamedTree) -> Peek e Outcome -> Peek e UnnamedTree
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e Outcome
forall e. Peeker e Outcome
peekOutcome StackIndex
idx


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

-- | Unmarshal a test outcome
peekOutcome :: Peeker e Outcome
peekOutcome :: Peeker e Outcome
peekOutcome StackIndex
idx = Name -> Peek e Outcome -> Peek e Outcome
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"test result" (Peek e Outcome -> Peek e Outcome)
-> Peek e Outcome -> Peek e Outcome
forall a b. (a -> b) -> a -> b
$ do
  LuaE e Type -> Peek e Type
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> LuaE e Type
forall e. StackIndex -> LuaE e Type
Lua.ltype StackIndex
idx) Peek e Type -> (Type -> Peek e Outcome) -> Peek e Outcome
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Type
Lua.TypeString  -> FilePath -> Outcome
Failure (FilePath -> Outcome) -> Peek e FilePath -> Peek e Outcome
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e FilePath
forall e. Peeker e FilePath
peekString StackIndex
idx
    Type
Lua.TypeBoolean -> do
      Bool
b <- LuaE e Bool -> Peek e Bool
forall e a. LuaE e a -> Peek e a
liftLua (LuaE e Bool -> Peek e Bool) -> LuaE e Bool -> Peek e Bool
forall a b. (a -> b) -> a -> b
$ StackIndex -> LuaE e Bool
forall e. StackIndex -> LuaE e Bool
toboolean StackIndex
idx
      Outcome -> Peek e Outcome
forall (m :: * -> *) a. Monad m => a -> m a
return (Outcome -> Peek e Outcome) -> Outcome -> Peek e Outcome
forall a b. (a -> b) -> a -> b
$ if Bool
b then Outcome
Success else FilePath -> Outcome
Failure FilePath
"???"
    Type
_ -> Name -> StackIndex -> Peek e ByteString
forall e. Name -> StackIndex -> Peek e ByteString
typeMismatchMessage Name
"string or boolean" StackIndex
idx Peek e ByteString
-> (ByteString -> Peek e Outcome) -> Peek e Outcome
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Peek e Outcome
forall a e. ByteString -> Peek e a
failPeek