{-# LANGUAGE OverloadedStrings   #-}
{-|
Module      : Foreign.Lua.Userdata
Copyright   : © 2007–2012 Gracjan Polak,
                2012–2016 Ömer Sinan Ağacan,
                2017-2020 Albert Krewinkel
License     : MIT
Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de>
Stability   : beta
Portability : non-portable (depends on GHC)

Convenience functions to convert Haskell values into Lua userdata.

The main purpose of this module is to allow fast and simple
creation of instances for @Peekable@ and @Pushable@. E.g., given
a data type Person

> data Person = Person { name :: String, age :: Int }
>    deriving (Eq, Show, Typeable, Data)

we can simply do

> instance Lua.Peekable Person where
>     safePeek = safePeekAny
>
> instance Lua.Pushable Person where
>     push = pushAny

The other functions can be used to exert more control over the userdata wrapping
and unwrapping process.
-}
module Foreign.Lua.Userdata
  ( pushAny
  , pushAnyWithMetatable
  , toAny
  , toAnyWithName
  , peekAny
  , ensureUserdataMetatable
  , metatableName
  ) where

import Control.Monad (when)
import Data.Data (Data, dataTypeName, dataTypeOf)
import Foreign.C (withCString)
import Foreign.Lua.Core (Lua)
import Foreign.Lua.Core.Types (liftLua, fromLuaBool)
import Foreign.Lua.Raw.Userdata
  ( hslua_fromuserdata
  , hslua_newhsuserdata
  , hslua_newudmetatable
  )
import Foreign.Lua.Types.Peekable (reportValueOnFailure)

import qualified Foreign.Lua.Core as Lua

-- | Push data by wrapping it into a userdata object.
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

-- | Push data by wrapping it into a userdata object, using the object at the
-- top of the stack after performing the given operation as metatable.
pushAnyWithMetatable :: Lua ()       -- ^ operation to push the metatable
                     -> a            -- ^ object to push to Lua.
                     -> Lua ()
pushAnyWithMetatable :: Lua () -> a -> Lua ()
pushAnyWithMetatable Lua ()
mtOp a
x = do
  (State -> IO ()) -> Lua ()
forall a. (State -> IO a) -> Lua a
liftLua ((State -> IO ()) -> Lua ()) -> (State -> IO ()) -> Lua ()
forall a b. (a -> b) -> a -> b
$ \State
l -> State -> a -> IO ()
forall a. State -> a -> IO ()
hslua_newhsuserdata State
l a
x
  Lua ()
mtOp
  StackIndex -> Lua ()
Lua.setmetatable (CInt -> StackIndex
Lua.nthFromTop CInt
2)
  () -> Lua ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Push the metatable used to define the behavior of the given value in Lua.
-- The table will be created if it doesn't exist yet.
ensureUserdataMetatable :: String     -- ^ name of the registered
                                      -- metatable which should be used.
                        -> Lua ()     -- ^ set additional properties; this
                                      -- operation will be called with the newly
                                      -- created metadata table at the top of
                                      -- the stack.
                        -> Lua ()
ensureUserdataMetatable :: String -> Lua () -> Lua ()
ensureUserdataMetatable String
name Lua ()
modMt = do
  Bool
mtCreated <- (State -> IO Bool) -> Lua Bool
forall a. (State -> IO a) -> Lua a
liftLua ((State -> IO Bool) -> Lua Bool) -> (State -> IO Bool) -> Lua Bool
forall a b. (a -> b) -> a -> b
$ \State
l ->
    LuaBool -> Bool
fromLuaBool (LuaBool -> Bool) -> IO LuaBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> (CString -> IO LuaBool) -> IO LuaBool
forall a. String -> (CString -> IO a) -> IO a
withCString String
name (State -> CString -> IO LuaBool
hslua_newudmetatable State
l)
  -- Execute additional modifications on metatable
  Bool -> Lua () -> Lua ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
mtCreated Lua ()
modMt

-- | Retrieve data which has been pushed with @'pushAny'@.
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)

-- | Retrieve data which has been pushed with @'pushAnyWithMetatable'@, where
-- *name* must is the value of the @__name@ field of the metatable.
toAnyWithName :: Lua.StackIndex
              -> String         -- ^ expected metatable name
              -> Lua (Maybe a)
toAnyWithName :: StackIndex -> String -> Lua (Maybe a)
toAnyWithName StackIndex
idx String
name = (State -> IO (Maybe a)) -> Lua (Maybe a)
forall a. (State -> IO a) -> Lua a
liftLua ((State -> IO (Maybe a)) -> Lua (Maybe a))
-> (State -> IO (Maybe a)) -> Lua (Maybe a)
forall a b. (a -> b) -> a -> b
$ \State
l ->
  String -> (CString -> IO (Maybe a)) -> IO (Maybe a)
forall a. String -> (CString -> IO a) -> IO a
withCString String
name (State -> StackIndex -> CString -> IO (Maybe a)
forall a. State -> StackIndex -> CString -> IO (Maybe a)
hslua_fromuserdata State
l StackIndex
idx)

-- | Retrieve Haskell data which was pushed to Lua as userdata.
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

-- | Return the default name for userdata to be used when wrapping an object as
-- the given type as userdata.  The argument is never evaluated.
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)