{-# LANGUAGE OverloadedStrings #-}
module Foreign.Lua.Userdata
( pushAny
, pushAnyWithMetatable
, toAny
, toAnyWithName
, peekAny
, ensureUserdataMetatable
, metatableName
) where
import Control.Monad (when)
import Data.Data (Data, dataTypeName, dataTypeOf)
import Foreign.Lua.Core (Lua)
import Foreign.Lua.Types.Peekable (reportValueOnFailure)
import qualified Foreign.Lua.Core as Lua
import qualified Foreign.C as C
import qualified Foreign.Ptr as Ptr
import qualified Foreign.StablePtr as StablePtr
import qualified Foreign.Storable as Storable
pushAny :: Data a
=> a
-> Lua ()
pushAny :: a -> Lua ()
pushAny a
x =
let name :: String
name = a -> String
forall a. Data a => a -> String
metatableName a
x
pushMetatable :: Lua ()
pushMetatable = String -> Lua () -> Lua ()
ensureUserdataMetatable String
name (() -> Lua ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
in Lua () -> a -> Lua ()
forall a. Lua () -> a -> Lua ()
pushAnyWithMetatable Lua ()
pushMetatable a
x
pushAnyWithMetatable :: Lua ()
-> a
-> Lua ()
pushAnyWithMetatable :: Lua () -> a -> Lua ()
pushAnyWithMetatable Lua ()
mtOp a
x = do
StablePtr a
xPtr <- IO (StablePtr a) -> Lua (StablePtr a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
Lua.liftIO (a -> IO (StablePtr a)
forall a. a -> IO (StablePtr a)
StablePtr.newStablePtr a
x)
Ptr ()
udPtr <- Int -> Lua (Ptr ())
Lua.newuserdata (StablePtr a -> Int
forall a. Storable a => a -> Int
Storable.sizeOf StablePtr a
xPtr)
IO () -> Lua ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
Lua.liftIO (IO () -> Lua ()) -> IO () -> Lua ()
forall a b. (a -> b) -> a -> b
$ Ptr (StablePtr a) -> StablePtr a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
Storable.poke (Ptr () -> Ptr (StablePtr a)
forall a b. Ptr a -> Ptr b
Ptr.castPtr Ptr ()
udPtr) StablePtr a
xPtr
Lua ()
mtOp
StackIndex -> Lua ()
Lua.setmetatable (CInt -> StackIndex
Lua.nthFromTop CInt
2)
() -> Lua ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
ensureUserdataMetatable :: String
-> Lua ()
-> Lua ()
ensureUserdataMetatable :: String -> Lua () -> Lua ()
ensureUserdataMetatable String
name Lua ()
modMt = do
Bool
mtCreated <- String -> Lua Bool
Lua.newmetatable String
name
Bool -> Lua () -> Lua ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
mtCreated (Lua () -> Lua ()) -> Lua () -> Lua ()
forall a b. (a -> b) -> a -> b
$ do
Bool -> Lua ()
Lua.pushboolean Bool
True
StackIndex -> String -> Lua ()
Lua.setfield (CInt -> StackIndex
Lua.nthFromTop CInt
2) String
"__metatable"
CFunction -> Lua ()
Lua.pushcfunction CFunction
hslua_userdata_gc_ptr
StackIndex -> String -> Lua ()
Lua.setfield (CInt -> StackIndex
Lua.nthFromTop CInt
2) String
"__gc"
Lua ()
modMt
toAny :: Data a => Lua.StackIndex -> Lua (Maybe a)
toAny :: StackIndex -> Lua (Maybe a)
toAny StackIndex
idx = a -> Lua (Maybe a)
forall a. Data a => a -> Lua (Maybe a)
toAny' a
forall a. HasCallStack => a
undefined
where
toAny' :: Data a => a -> Lua (Maybe a)
toAny' :: a -> Lua (Maybe a)
toAny' a
x = StackIndex -> String -> Lua (Maybe a)
forall a. StackIndex -> String -> Lua (Maybe a)
toAnyWithName StackIndex
idx (a -> String
forall a. Data a => a -> String
metatableName a
x)
toAnyWithName :: Lua.StackIndex
-> String
-> Lua (Maybe a)
toAnyWithName :: StackIndex -> String -> Lua (Maybe a)
toAnyWithName StackIndex
idx String
name = do
State
l <- Lua State
Lua.state
Ptr ()
udPtr <- IO (Ptr ()) -> Lua (Ptr ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
Lua.liftIO (String -> (CString -> IO (Ptr ())) -> IO (Ptr ())
forall a. String -> (CString -> IO a) -> IO a
C.withCString String
name (State -> StackIndex -> CString -> IO (Ptr ())
luaL_testudata State
l StackIndex
idx))
if Ptr ()
udPtr Ptr () -> Ptr () -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr ()
forall a. Ptr a
Ptr.nullPtr
then Maybe a -> Lua (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
else
(a -> Maybe a) -> Lua a -> Lua (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just (Lua a -> Lua (Maybe a))
-> (IO a -> Lua a) -> IO a -> Lua (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> Lua a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
Lua.liftIO (IO a -> Lua (Maybe a)) -> IO a -> Lua (Maybe a)
forall a b. (a -> b) -> a -> b
$
Ptr (StablePtr a) -> IO (StablePtr a)
forall a. Storable a => Ptr a -> IO a
Storable.peek (Ptr () -> Ptr (StablePtr a)
forall a b. Ptr a -> Ptr b
Ptr.castPtr Ptr ()
udPtr) IO (StablePtr a) -> (StablePtr a -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= StablePtr a -> IO a
forall a. StablePtr a -> IO a
StablePtr.deRefStablePtr
peekAny :: Data a => Lua.StackIndex -> Lua a
peekAny :: StackIndex -> Lua a
peekAny StackIndex
idx = a -> Lua a
forall a. Data a => a -> Lua a
peek' a
forall a. HasCallStack => a
undefined
where
peek' :: Data a => a -> Lua a
peek' :: a -> Lua a
peek' a
x = String -> (StackIndex -> Lua (Maybe a)) -> StackIndex -> Lua a
forall a.
String -> (StackIndex -> Lua (Maybe a)) -> StackIndex -> Lua a
reportValueOnFailure (DataType -> String
dataTypeName (a -> DataType
forall a. Data a => a -> DataType
dataTypeOf a
x)) StackIndex -> Lua (Maybe a)
forall a. Data a => StackIndex -> Lua (Maybe a)
toAny StackIndex
idx
metatableName :: Data a => a -> String
metatableName :: a -> String
metatableName a
x = String
"HSLUA_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ DataType -> String
dataTypeName (a -> DataType
forall a. Data a => a -> DataType
dataTypeOf a
x)
foreign import ccall "&hslua_userdata_gc"
hslua_userdata_gc_ptr :: Lua.CFunction
foreign import ccall "luaL_testudata"
luaL_testudata :: Lua.State -> Lua.StackIndex -> C.CString -> IO (Ptr.Ptr ())