-
-
Notifications
You must be signed in to change notification settings - Fork 28
Expand file tree
/
Copy pathUserdata.hs
More file actions
85 lines (78 loc) · 2.72 KB
/
Userdata.hs
File metadata and controls
85 lines (78 loc) · 2.72 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
{-# LANGUAGE CPP #-}
{-|
Module : Lua.Userdata
Copyright : © 2017-2021 Albert Krewinkel
License : MIT
Maintainer : Albert Krewinkel <tarleb+hslua@zeitkraut.de>
Stability : beta
Portability : ForeignFunctionInterface
Bindings to HsLua-specific functions used to push Haskell values
as userdata.
-}
module Lua.Userdata
( hslua_fromuserdata
, hslua_newhsuserdata
, hslua_newudmetatable
, hslua_putuserdata
) where
import Foreign.C (CInt (CInt), CString)
import Lua.Auxiliary (luaL_testudata)
import Lua.Primary (lua_newuserdata)
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
-- | Creates and registers a new metatable for a userdata-wrapped
-- Haskell value; checks whether a metatable of that name has been
-- registered yet and uses the registered table if possible.
foreign import ccall SAFTY "hsludata.h hslua_newudmetatable"
hslua_newudmetatable :: State -- ^ Lua state
-> CString -- ^ Userdata name (__name)
-> IO LuaBool -- ^ True iff new metatable
-- was created.
-- | Creates a new userdata wrapping the given Haskell object.
hslua_newhsuserdata :: State -> a -> IO ()
hslua_newhsuserdata l x = do
xPtr <- newStablePtr x
udPtr <- lua_newuserdata l (fromIntegral $ sizeOf xPtr)
poke (castPtr udPtr) xPtr
{-# INLINABLE hslua_newhsuserdata #-}
-- | Retrieves a Haskell object from userdata at the given index.
-- The userdata /must/ have the given name.
hslua_fromuserdata :: State
-> StackIndex -- ^ userdata index
-> CString -- ^ name
-> IO (Maybe a)
hslua_fromuserdata l idx name = do
udPtr <- luaL_testudata l idx name
if udPtr == nullPtr
then return Nothing
else Just <$> (peek (castPtr udPtr) >>= deRefStablePtr)
{-# INLINABLE hslua_fromuserdata #-}
-- | Replaces the Haskell value contained in the userdata value at
-- @index@. Checks that the userdata is of type @name@ and returns
-- 'True' on success, or 'False' otherwise.
hslua_putuserdata :: State
-> StackIndex -- ^ index
-> CString -- ^ name
-> a -- ^ new Haskell value
-> IO Bool
hslua_putuserdata l idx name x = do
xPtr <- newStablePtr 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 #-}