content: {-# LANGUAGE LambdaCase #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE TypeApplications #-}
  {-|
  Module      : HsLua.Packaging.Module
  Copyright   : © 2019-2024 Albert Krewinkel
  License     : MIT
  Maintainer  : Albert Krewinkel <tarleb@hslua.org>
  Stability   : alpha
  Portability : Requires GHC 8 or later.
  
  Tests for HsLua.
  -}
  module HsLuaTests (tests) where
  
  import Prelude hiding (concat)
  
  import Control.Monad (void)
  import Data.ByteString (append)
  import Data.Data (Typeable)
  import Data.Either (isLeft)
  import HsLua as Lua
  import System.Mem (performMajorGC)
  import Test.Tasty.HsLua ( (=:), (?:), pushLuaExpr, shouldBeErrorMessageOf
                         , shouldHoldForResultOf)
  import Test.Tasty (TestTree, testGroup)
  import Test.Tasty.HUnit ((@?=), assertBool, assertEqual, testCase)
  
  import qualified Control.Monad.Catch as Catch
  import qualified Data.ByteString.Char8 as Char8
  import qualified Data.Text as T
  import qualified Data.Text.Encoding as T
  import qualified HsLua.Core.Utf8 as Utf8
  
  -- | Specifications for Attributes parsing functions.
  tests :: TestTree
  tests = testGroup "Lua integration tests"
    [ testCase "print version" .
      run $ do
        openlibs
        void $ getglobal @Lua.Exception "assert"
        pushstring "Hello from "
        void $ getglobal @Lua.Exception "_VERSION"
        concat 2
        call 1 0
  
    , "getting a nested global works" ?: do
        pushLuaExpr @Lua.Exception "{greeting = 'Moin'}"
        setglobal "hamburg"
  
        getglobal' "hamburg.greeting"
        pushLuaExpr "'Moin'"
        equal (-1) (-2)
  
    , "setting a nested global works" ?: do
        let v = "Mitte"
        newtable
        setglobal @Lua.Exception "berlin"
  
        pushstring v
        setglobal' "berlin.neighborhood"
        v' <- getglobal' "berlin.neighborhood" *> tostring (-1)
        return (Just v == v')
  
    , testCase "table reading" .
      run @Lua.Exception $ do
        openbase
        let tableStr = "{firstname = 'Jane', surname = 'Doe'}"
        pushLuaExpr $ "setmetatable(" `append` tableStr `append` ", {'yup'})"
        void $ getfield top "firstname"
        firstname <- tostring top <* pop 1
        liftIO (assertEqual "Wrong value for firstname" (Just "Jane") firstname)
  
        pushstring "surname"
        rawget (-2)
        surname <- tostring top <* pop 1
        liftIO (assertEqual "Wrong value for surname" surname (Just "Doe"))
  
        hasMetaTable <- getmetatable (-1)
        liftIO (assertBool "getmetatable returned wrong result" hasMetaTable)
        rawgeti (-1) 1
        mt1 <- tostring top <* pop 1
        liftIO (assertEqual "Metatable content not as expected " mt1 (Just "yup"))
  
    , testGroup "Getting strings to and from the stack"
      [ testCase "unicode ByteString" $ do
          let val = T.pack "öçşiğüİĞı"
          val' <- run $ do
            pushstring (T.encodeUtf8 val)
            fmap T.decodeUtf8 `fmap` tostring 1
          assertEqual "Popped a different value or pop failed" (Just val) val'
  
      , testCase "ByteString should survive after GC/Lua destroyed" $ do
          (val, val') <- run $ do
            let v = "ByteString should survive"
            pushstring v
            v' <- tostring 1
            pop 1
            return (Just v, v')
          performMajorGC
          assertEqual "Popped a different value or pop failed" val val'
      , testCase "String with NUL byte should be pushed/popped correctly" $ do
          let str = "A\NULB"
          str' <- run $ pushstring (Char8.pack str) *> tostring 1
          assertEqual "Popped string is different than what's pushed"
            (Just str) (Char8.unpack <$> str')
      ]
  
    , testGroup "luaopen_* functions" $ map (uncurry testOpen)
      [ ("base", openbase)
      , ("debug", opendebug)
      , ("io", openio)
      , ("math", openmath)
      , ("os", openos)
      , ("package", openpackage)
      , ("string", openstring)
      , ("table", opentable)
      ]
  
    , testGroup "error handling"
      [ "catching error of a failing meta method" =:
        isLeft `shouldHoldForResultOf`
        let comp = do
              pushLuaExpr "setmetatable({}, {__index = error})"
              void $ getfield (-1) "foo"
        in try comp
  
      , "calling a function that errors throws exception" =:
        "[string \"return error('error message')\"]:1: error message"
        `shouldBeErrorMessageOf` do
          openbase
          loadstring "return error('error message')" *> call 0 1
  
      , let errTbl ="setmetatable({}, {__index = function(t, k) error(k) end})"
        in testGroup "error conversion"
        [ "throw custom exceptions" =: do
            let comp = do
                  openlibs
                  pushLuaExpr errTbl
                  pushnumber 23
                  void $ gettable (Lua.nth 2)
            result <- tryCustom comp
            result @?= Left (ExceptionWithNumber 23)
  
        , "catch custom exception in exposed function" =: do
            let frob = do
                  openlibs
                  pushLuaExpr errTbl
                  pushnumber 42
                  _ <- gettable (Lua.nth 2)
                  return (NumResults 1)
            result <- tryCustom $ do
              openlibs
              pushHaskellFunction frob
              call (NumArgs 0) (NumResults 1)
            result @?= Left (ExceptionWithNumber 42)
  
        , "pass exception through Lua" =: do
            let frob :: LuaE CustomException NumResults
                frob = Catch.throwM (ExceptionWithMessage "borked")
            result <- tryCustom $ do
              pushHaskellFunction frob
              call (NumArgs 0) (NumResults 0)
            result @?= Left (ExceptionWithMessage "borked")
        ]
      ]
    ]
  
  -------------------------------------------------------------------------------
  -- luaopen_* functions
  
  testOpen :: String -> Lua () -> TestTree
  testOpen lib openfn = testCase ("open" ++ lib) $
    assertBool "opening the library failed" =<<
    run (openfn *> istable (-1))
  
  
  -------------------------------------------------------------------------------
  -- Custom exception handling
  
  data CustomException =
      ExceptionWithNumber Lua.Number
    | ExceptionWithMessage String
    deriving (Eq, Show, Typeable)
  
  instance Catch.Exception CustomException
  
  instance LuaError CustomException where
    pushException = \case
      ExceptionWithMessage m -> pushstring (Utf8.fromString m)
      ExceptionWithNumber n  -> pushnumber n
    popException = do
      Lua.tonumber Lua.top >>= \case
        Just num -> do
          Lua.pop 1
          return (ExceptionWithNumber num)
        _        -> do
          l <- Lua.state
          msg <- Lua.liftIO (Lua.popErrorMessage l)
          return (ExceptionWithMessage (Utf8.toString msg))
    luaException = ExceptionWithMessage
  
  tryCustom :: LuaE CustomException a -> IO (Either CustomException a)
  tryCustom = Catch.try . Lua.run
  
  -- instance Lua
  -- customAlternative :: Lua a -> Lua a -> Lua a
  -- customAlternative x y = Catch.try x >>= \case
  --   Left (_ :: CustomException) -> y
  --   Right x' -> return x'
  