1{-# LANGUAGE OverloadedStrings #-} 2{-| 3Module : Foreign.Lua.Userdata 4Copyright : © 2007–2012 Gracjan Polak, 5 2012–2016 Ömer Sinan Ağacan, 6 2017-2020 Albert Krewinkel 7License : MIT 8Maintainer : Albert Krewinkel <tarleb+hslua@zeitkraut.de> 9Stability : beta 10Portability : non-portable (depends on GHC) 11 12Convenience functions to convert Haskell values into Lua userdata. 13 14The main purpose of this module is to allow fast and simple 15creation of instances for @Peekable@ and @Pushable@. E.g., given 16a data type Person 17 18> data Person = Person { name :: String, age :: Int } 19> deriving (Eq, Show, Typeable, Data) 20 21we can simply do 22 23> instance Lua.Peekable Person where 24> safePeek = safePeekAny 25> 26> instance Lua.Pushable Person where 27> push = pushAny 28 29The other functions can be used to exert more control over the userdata wrapping 30and unwrapping process. 31-} 32module Foreign.Lua.Userdata 33 ( pushAny 34 , pushAnyWithMetatable 35 , toAny 36 , toAnyWithName 37 , peekAny 38 , ensureUserdataMetatable 39 , metatableName 40 ) where 41 42import Control.Monad (when) 43import Data.Data (Data, dataTypeName, dataTypeOf) 44import Foreign.C (withCString) 45import Foreign.Lua.Core (Lua) 46import Foreign.Lua.Core.Types (liftLua, fromLuaBool) 47import Foreign.Lua.Raw.Userdata 48 ( hslua_fromuserdata 49 , hslua_newhsuserdata 50 , hslua_newudmetatable 51 ) 52import Foreign.Lua.Types.Peekable (reportValueOnFailure) 53 54import qualified Foreign.Lua.Core as Lua 55 56-- | Push data by wrapping it into a userdata object. 57pushAny :: Data a 58 => a 59 -> Lua () 60pushAny x = 61 let name = metatableName x 62 pushMetatable = ensureUserdataMetatable name (return ()) 63 in pushAnyWithMetatable pushMetatable x 64 65-- | Push data by wrapping it into a userdata object, using the object at the 66-- top of the stack after performing the given operation as metatable. 67pushAnyWithMetatable :: Lua () -- ^ operation to push the metatable 68 -> a -- ^ object to push to Lua. 69 -> Lua () 70pushAnyWithMetatable mtOp x = do 71 liftLua $ \l -> hslua_newhsuserdata l x 72 mtOp 73 Lua.setmetatable (Lua.nthFromTop 2) 74 return () 75 76-- | Push the metatable used to define the behavior of the given value in Lua. 77-- The table will be created if it doesn't exist yet. 78ensureUserdataMetatable :: String -- ^ name of the registered 79 -- metatable which should be used. 80 -> Lua () -- ^ set additional properties; this 81 -- operation will be called with the newly 82 -- created metadata table at the top of 83 -- the stack. 84 -> Lua () 85ensureUserdataMetatable name modMt = do 86 mtCreated <- liftLua $ \l -> 87 fromLuaBool <$> withCString name (hslua_newudmetatable l) 88 -- Execute additional modifications on metatable 89 when mtCreated modMt 90 91-- | Retrieve data which has been pushed with @'pushAny'@. 92toAny :: Data a => Lua.StackIndex -> Lua (Maybe a) 93toAny idx = toAny' undefined 94 where 95 toAny' :: Data a => a -> Lua (Maybe a) 96 toAny' x = toAnyWithName idx (metatableName x) 97 98-- | Retrieve data which has been pushed with @'pushAnyWithMetatable'@, where 99-- *name* must is the value of the @__name@ field of the metatable. 100toAnyWithName :: Lua.StackIndex 101 -> String -- ^ expected metatable name 102 -> Lua (Maybe a) 103toAnyWithName idx name = liftLua $ \l -> 104 withCString name (hslua_fromuserdata l idx) 105 106-- | Retrieve Haskell data which was pushed to Lua as userdata. 107peekAny :: Data a => Lua.StackIndex -> Lua a 108peekAny idx = peek' undefined 109 where 110 peek' :: Data a => a -> Lua a 111 peek' x = reportValueOnFailure (dataTypeName (dataTypeOf x)) toAny idx 112 113-- | Return the default name for userdata to be used when wrapping an object as 114-- the given type as userdata. The argument is never evaluated. 115metatableName :: Data a => a -> String 116metatableName x = "HSLUA_" ++ dataTypeName (dataTypeOf x) 117