{-# LANGUAGE OverloadedStrings #-}
{-|
Module      : Test.Tasty.HsLua
Copyright   : © 2017-2022 Albert Krewinkel
License     : MIT
Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de>
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 :: 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 (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 :: 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 String
msg) -> String -> Assertion
forall a. HasCallStack => String -> IO a
assertFailure (String -> Assertion) -> String -> Assertion
forall a b. (a -> b) -> a -> b
$ String
"Lua operation failed with "
                                String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"message: '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'"
    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 :: String -> Lua a -> Assertion
shouldBeErrorMessageOf String
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 String
msg) -> String
msg String -> String -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= String
expectedErrMsg
    Right a
res ->
      String -> Assertion
forall a. HasCallStack => String -> IO a
assertFailure (String
"Lua operation succeeded unexpectedly and returned "
                     String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
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 :: (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 String
msg) -> String -> Assertion
forall a. HasCallStack => String -> IO a
assertFailure (String -> Assertion) -> String -> Assertion
forall a b. (a -> b) -> a -> b
$ String
"Lua operation failed with "
                                String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"message: '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'"
    Right a
res -> HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool (String
"predicate doesn't hold for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
res)
                            (a -> Bool
predicate a
res)

-- | Checks whether the operation returns 'True'.
assertLuaBool :: HasCallStack => LuaE e Bool -> Assertion
assertLuaBool :: LuaE e Bool -> Assertion
assertLuaBool LuaE e Bool
luaOp = HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"" (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 :: String -> LuaE e Bool -> TestTree
luaTestBool String
msg LuaE e Bool
luaOp = String -> Assertion -> TestTree
testCase String
msg (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
  HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"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
=: :: String -> Assertion -> TestTree
(=:) = String -> Assertion -> TestTree
testCase
infix  3 =:

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