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