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