{-# LANGUAGE CPP #-}
module Lua.Userdata
( hslua_fromuserdata
, hslua_newhsuserdatauv
, hslua_newudmetatable
, hslua_putuserdata
) where
import Foreign.C (CInt (CInt), CString)
import Lua.Auxiliary (luaL_testudata)
import Lua.Primary (lua_newuserdatauv)
import Lua.Types
( LuaBool (..)
, StackIndex (..)
, State (..)
)
import Foreign.Ptr (castPtr, nullPtr)
import Foreign.StablePtr (newStablePtr, deRefStablePtr, freeStablePtr)
import Foreign.Storable (peek, poke, sizeOf)
#ifdef ALLOW_UNSAFE_GC
#define SAFTY unsafe
#else
#define SAFTY safe
#endif
foreign import ccall SAFTY "hsludata.h hslua_newudmetatable"
hslua_newudmetatable :: State
-> CString
-> IO LuaBool
hslua_newhsuserdatauv :: State
-> a
-> CInt
-> IO ()
hslua_newhsuserdatauv :: forall a. State -> a -> CInt -> IO ()
hslua_newhsuserdatauv State
l a
x CInt
nuvalue = do
xPtr <- a -> IO (StablePtr a)
forall a. a -> IO (StablePtr a)
newStablePtr a
x
udPtr <- lua_newuserdatauv l (fromIntegral $ sizeOf xPtr) nuvalue
poke (castPtr udPtr) xPtr
{-# INLINABLE hslua_newhsuserdatauv #-}
hslua_fromuserdata :: State
-> StackIndex
-> CString
-> IO (Maybe a)
hslua_fromuserdata :: forall a. State -> StackIndex -> CString -> IO (Maybe a)
hslua_fromuserdata State
l StackIndex
idx CString
name = do
udPtr <- State -> StackIndex -> CString -> IO (Ptr ())
luaL_testudata State
l StackIndex
idx CString
name
if udPtr == nullPtr
then return Nothing
else Just <$> (peek (castPtr udPtr) >>= deRefStablePtr)
{-# INLINABLE hslua_fromuserdata #-}
hslua_putuserdata :: State
-> StackIndex
-> CString
-> a
-> IO Bool
hslua_putuserdata :: forall a. State -> StackIndex -> CString -> a -> IO Bool
hslua_putuserdata State
l StackIndex
idx CString
name a
x = do
xPtr <- a -> IO (StablePtr a)
forall a. a -> IO (StablePtr a)
newStablePtr a
x
udPtr <- luaL_testudata l idx name
if udPtr == nullPtr
then return False
else do
peek (castPtr udPtr) >>= freeStablePtr
poke (castPtr udPtr) xPtr
return True
{-# INLINABLE hslua_putuserdata #-}