{-# LANGUAGE OverloadedStrings #-}
{-|
Module      : Test.Tasty.HsLua
Copyright   : © 2017-2024 Albert Krewinkel
License     : MIT
Maintainer  : Albert Krewinkel <tarleb@hslua.org>
Stability   : beta
Portability : non-portable (depends on GHC)

Utilities for testing of HsLua operations.
-}
module Test.Tasty.HsLua
  ( assertLuaBool
  , pushLuaExpr
  , shouldBeErrorMessageOf
  , shouldBeResultOf
  , shouldHoldForResultOf
  , (=:)
  , (?:)
  ) where

import Data.ByteString (ByteString, append)
import HsLua.Core
  (Lua, LuaE, LuaError, run, runEither, loadstring, call, multret)
import Test.Tasty (TestTree)
import Test.Tasty.HUnit
  (Assertion, HasCallStack, assertBool, assertFailure, testCase, (@?=))

import qualified HsLua.Core as Lua

-- | Takes a Lua expression as a 'ByteString', evaluates it and pushes
-- the result to the stack.
--
-- > -- will return "12"
-- > run $ do
-- >   pushLuaExpr "7 + 5"
-- >   tointeger top
pushLuaExpr :: LuaError e => ByteString -> LuaE e ()
pushLuaExpr :: forall e. LuaError e => ByteString -> LuaE e ()
pushLuaExpr ByteString
expr = ByteString -> LuaE e Status
forall e. ByteString -> LuaE e Status
loadstring (ByteString
"return " ByteString -> ByteString -> ByteString
`append` ByteString
expr) LuaE e Status -> LuaE e () -> LuaE e ()
forall a b. LuaE e a -> LuaE e b -> LuaE e b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> NumArgs -> NumResults -> LuaE e ()
forall e. LuaError e => NumArgs -> NumResults -> LuaE e ()
call NumArgs
0 NumResults
multret

-- | Takes a value and a 'Lua' operation and turns them into an
-- 'Assertion' which checks that the operation produces the given value.
shouldBeResultOf :: (HasCallStack, Eq a, Show a)
                 => a -> Lua a -> Assertion
shouldBeResultOf :: forall a. (HasCallStack, Eq a, Show a) => a -> Lua a -> Assertion
shouldBeResultOf a
expected Lua a
luaOp = do
  Either Exception a
errOrRes <- Lua a -> IO (Either Exception a)
forall e a. Exception e => LuaE e a -> IO (Either e a)
runEither Lua a
luaOp
  case Either Exception a
errOrRes of
    Left (Lua.Exception [Char]
msg) -> [Char] -> Assertion
forall a. HasCallStack => [Char] -> IO a
assertFailure ([Char] -> Assertion) -> [Char] -> Assertion
forall a b. (a -> b) -> a -> b
$ [Char]
"Lua operation failed with "
                                [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"message: '" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
msg [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"'"
    Right a
res -> a
res a -> a -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= a
expected

-- | Checks whether a 'Lua' operation fails with the given string as
-- error message.
shouldBeErrorMessageOf :: (HasCallStack, Show a)
                       => String -> Lua a -> Assertion
shouldBeErrorMessageOf :: forall a. (HasCallStack, Show a) => [Char] -> Lua a -> Assertion
shouldBeErrorMessageOf [Char]
expectedErrMsg Lua a
luaOp = do
  Either Exception a
errOrRes <- Lua a -> IO (Either Exception a)
forall e a. Exception e => LuaE e a -> IO (Either e a)
runEither Lua a
luaOp
  case Either Exception a
errOrRes of
    Left (Lua.Exception [Char]
msg) -> [Char]
msg [Char] -> [Char] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= [Char]
expectedErrMsg
    Right a
res ->
      [Char] -> Assertion
forall a. HasCallStack => [Char] -> IO a
assertFailure ([Char]
"Lua operation succeeded unexpectedly and returned "
                     [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
res)

-- | Checks whether the return value of an operation holds for the given
-- predicate.
shouldHoldForResultOf :: (HasCallStack, Show a)
                      => (a -> Bool) -> Lua a -> Assertion
shouldHoldForResultOf :: forall a.
(HasCallStack, Show a) =>
(a -> Bool) -> Lua a -> Assertion
shouldHoldForResultOf a -> Bool
predicate Lua a
luaOp = do
  Either Exception a
errOrRes <- Lua a -> IO (Either Exception a)
forall e a. Exception e => LuaE e a -> IO (Either e a)
runEither Lua a
luaOp
  case Either Exception a
errOrRes of
    Left (Lua.Exception [Char]
msg) -> [Char] -> Assertion
forall a. HasCallStack => [Char] -> IO a
assertFailure ([Char] -> Assertion) -> [Char] -> Assertion
forall a b. (a -> b) -> a -> b
$ [Char]
"Lua operation failed with "
                                [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"message: '" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
msg [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"'"
    Right a
res -> HasCallStack => [Char] -> Bool -> Assertion
[Char] -> Bool -> Assertion
assertBool ([Char]
"predicate doesn't hold for " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
res)
                            (a -> Bool
predicate a
res)

-- | Checks whether the operation returns 'True'.
assertLuaBool :: HasCallStack => LuaE e Bool -> Assertion
assertLuaBool :: forall e. HasCallStack => LuaE e Bool -> Assertion
assertLuaBool LuaE e Bool
luaOp = HasCallStack => [Char] -> Bool -> Assertion
[Char] -> Bool -> Assertion
assertBool [Char]
"" (Bool -> Assertion) -> IO Bool -> Assertion
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LuaE e Bool -> IO Bool
forall e a. LuaE e a -> IO a
run LuaE e Bool
luaOp

-- | Creates a new test case with the given name, checking whether the
-- operation returns 'True'.
luaTestBool :: HasCallStack => String -> LuaE e Bool -> TestTree
luaTestBool :: forall e. HasCallStack => [Char] -> LuaE e Bool -> TestTree
luaTestBool [Char]
msg LuaE e Bool
luaOp = [Char] -> Assertion -> TestTree
testCase [Char]
msg (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
  HasCallStack => [Char] -> Bool -> Assertion
[Char] -> Bool -> Assertion
assertBool [Char]
"Lua operation returned false" (Bool -> Assertion) -> IO Bool -> Assertion
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LuaE e Bool -> IO Bool
forall e a. LuaE e a -> IO a
run LuaE e Bool
luaOp

-- | Infix alias for 'testCase'.
(=:) :: String -> Assertion -> TestTree
=: :: [Char] -> Assertion -> TestTree
(=:) = [Char] -> Assertion -> TestTree
testCase
infix  3 =:

-- | Infix alias for 'luaTestBool'.
(?:) :: HasCallStack => String -> LuaE e Bool -> TestTree
?: :: forall e. HasCallStack => [Char] -> LuaE e Bool -> TestTree
(?:) = [Char] -> LuaE e Bool -> TestTree
forall e. HasCallStack => [Char] -> LuaE e Bool -> TestTree
luaTestBool
infixr 3 ?: