{-|
Module      : Foreign.Lua.Raw.Error
Copyright   : © 2017-2020 Albert Krewinkel
License     : MIT
Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de>
Stability   : beta
Portability : portable

Lua exceptions and exception handling.
-}
module Foreign.Lua.Raw.Error
  ( -- * Passing Lua errors to Haskell
    errorMessage
  ) where

import Data.ByteString (ByteString)
import Foreign.Lua.Raw.Auxiliary (hsluaL_tolstring)
import Foreign.Lua.Raw.Functions (lua_pop)
import Foreign.Marshal.Alloc (alloca)
import Foreign.Ptr (nullPtr)

import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as Char8
import qualified Foreign.Storable as Storable
import qualified Foreign.Lua.Raw.Types as Lua

-- | Retrieve and pop the top object as an error message. This is very similar
-- to tostring', but ensures that we don't recurse if getting the message
-- failed.
errorMessage :: Lua.State -> IO ByteString
errorMessage :: State -> IO ByteString
errorMessage State
l = (Ptr CSize -> IO ByteString) -> IO ByteString
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CSize -> IO ByteString) -> IO ByteString)
-> (Ptr CSize -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr CSize
lenPtr -> do
  Ptr CChar
cstr <- State -> StackIndex -> Ptr CSize -> IO (Ptr CChar)
hsluaL_tolstring State
l (-StackIndex
1) Ptr CSize
lenPtr
  if Ptr CChar
cstr Ptr CChar -> Ptr CChar -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CChar
forall a. Ptr a
nullPtr
    then ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ String -> ByteString
Char8.pack (String
"An error occurred, but the error object " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                              String
"cannot be converted into a string.")
    else do
      CSize
cstrLen <- Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
Storable.peek Ptr CSize
lenPtr
      ByteString
msg <- CStringLen -> IO ByteString
B.packCStringLen (Ptr CChar
cstr, CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
cstrLen)
      State -> StackIndex -> IO ()
lua_pop State
l StackIndex
2
      ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
msg