1{-# LANGUAGE CPP #-} 2{-| 3Module : Foreign.Lua.Raw.Userdata 4Copyright : © 2017-2020 Albert Krewinkel 5License : MIT 6Maintainer : Albert Krewinkel <tarleb+hslua@zeitkraut.de> 7Stability : beta 8Portability : ForeignFunctionInterface 9 10Bindings to HsLua-specific functions used to push Haskell values 11as userdata. 12-} 13module Foreign.Lua.Raw.Userdata 14 ( hslua_fromuserdata 15 , hslua_newhsuserdata 16 , hslua_newudmetatable 17 ) where 18 19import Foreign.C (CInt (CInt), CString) 20import Foreign.Lua.Raw.Auxiliary (luaL_testudata) 21import Foreign.Lua.Raw.Functions (lua_newuserdata) 22import Foreign.Lua.Raw.Types 23 ( LuaBool (..) 24 , StackIndex (..) 25 , State (..) 26 ) 27import Foreign.Ptr (castPtr, nullPtr) 28import Foreign.StablePtr (newStablePtr, deRefStablePtr) 29import Foreign.Storable (peek, poke, sizeOf) 30 31#ifdef ALLOW_UNSAFE_GC 32#define SAFTY unsafe 33#else 34#define SAFTY safe 35#endif 36 37-- | Creates and registers a new metatable for a userdata-wrapped 38-- Haskell value; checks whether a metatable of that name has been 39-- registered yet and uses the registered table if possible. 40foreign import ccall SAFTY "hsludata.h hslua_newudmetatable" 41 hslua_newudmetatable :: State -- ^ Lua state 42 -> CString -- ^ Userdata name (__name) 43 -> IO LuaBool -- ^ True iff new metatable 44 -- was created. 45 46-- | Creates a new userdata wrapping the given Haskell object. 47hslua_newhsuserdata :: State -> a -> IO () 48hslua_newhsuserdata l x = do 49 xPtr <- newStablePtr x 50 udPtr <- lua_newuserdata l (fromIntegral $ sizeOf xPtr) 51 poke (castPtr udPtr) xPtr 52{-# INLINABLE hslua_newhsuserdata #-} 53 54-- | Retrieves a Haskell object from userdata at the given index. 55-- The userdata /must/ have the given name. 56hslua_fromuserdata :: State 57 -> StackIndex -- ^ userdata index 58 -> CString -- ^ name 59 -> IO (Maybe a) 60hslua_fromuserdata l idx name = do 61 udPtr <- luaL_testudata l idx name 62 if udPtr == nullPtr 63 then return Nothing 64 else Just <$> (peek (castPtr udPtr) >>= deRefStablePtr) 65{-# INLINABLE hslua_fromuserdata #-} 66