{-# LANGUAGE RankNTypes #-}
{-|
Module      : HsLua.Core.Userdata
Copyright   : © 2007–2012 Gracjan Polak;
              © 2012–2016 Ömer Sinan Ağacan;
              © 2017-2021 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.
-}
module HsLua.Core.Userdata
  ( newhsuserdata
  , newudmetatable
  , fromuserdata
  , putuserdata
  ) where

import HsLua.Core.Types (LuaE, Name (..), StackIndex, liftLua, fromLuaBool)
import Lua.Userdata
  ( hslua_fromuserdata
  , hslua_newhsuserdata
  , hslua_newudmetatable
  , hslua_putuserdata
  )
import qualified Data.ByteString as B

-- | Creates a new userdata wrapping the given Haskell object. The
-- userdata is pushed to the top of the stack.
newhsuserdata :: forall a e. a -> LuaE e ()
newhsuserdata :: a -> LuaE e ()
newhsuserdata = (State -> IO ()) -> LuaE e ()
forall a e. (State -> IO a) -> LuaE e a
liftLua ((State -> IO ()) -> LuaE e ())
-> (a -> State -> IO ()) -> a -> LuaE e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State -> a -> IO ()) -> a -> State -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip State -> a -> IO ()
forall a. State -> a -> IO ()
hslua_newhsuserdata
{-# INLINABLE newhsuserdata #-}

-- | 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.
--
-- Using a metatable created by this functions ensures that the pointer
-- to the Haskell value will be freed when the userdata object is
-- garbage collected in Lua.
--
-- The name may not contain a nul character.
newudmetatable :: Name -> LuaE e Bool
newudmetatable :: Name -> LuaE e Bool
newudmetatable (Name ByteString
name) = (State -> IO Bool) -> LuaE e Bool
forall a e. (State -> IO a) -> LuaE e a
liftLua ((State -> IO Bool) -> LuaE e Bool)
-> (State -> IO Bool) -> LuaE e Bool
forall a b. (a -> b) -> a -> b
$ \State
l ->
  ByteString -> (CString -> IO Bool) -> IO Bool
forall a. ByteString -> (CString -> IO a) -> IO a
B.useAsCString ByteString
name ((LuaBool -> Bool) -> IO LuaBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LuaBool -> Bool
fromLuaBool (IO LuaBool -> IO Bool)
-> (CString -> IO LuaBool) -> CString -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> CString -> IO LuaBool
hslua_newudmetatable State
l)
{-# INLINABLE newudmetatable #-}

-- | Retrieves a Haskell object from userdata at the given index. The
-- userdata /must/ have the given name.
fromuserdata :: forall a e.
                StackIndex  -- ^ stack index of userdata
             -> Name        -- ^ expected name of userdata object
             -> LuaE e (Maybe a)
fromuserdata :: StackIndex -> Name -> LuaE e (Maybe a)
fromuserdata StackIndex
idx (Name ByteString
name) = (State -> IO (Maybe a)) -> LuaE e (Maybe a)
forall a e. (State -> IO a) -> LuaE e a
liftLua ((State -> IO (Maybe a)) -> LuaE e (Maybe a))
-> (State -> IO (Maybe a)) -> LuaE e (Maybe a)
forall a b. (a -> b) -> a -> b
$ \State
l ->
  ByteString -> (CString -> IO (Maybe a)) -> IO (Maybe a)
forall a. ByteString -> (CString -> IO a) -> IO a
B.useAsCString ByteString
name (State -> StackIndex -> CString -> IO (Maybe a)
forall a. State -> StackIndex -> CString -> IO (Maybe a)
hslua_fromuserdata State
l StackIndex
idx)
{-# INLINABLE 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.
putuserdata :: forall a e.
               StackIndex   -- ^ index
            -> Name         -- ^ name
            -> a            -- ^ new value
            -> LuaE e Bool
putuserdata :: StackIndex -> Name -> a -> LuaE e Bool
putuserdata StackIndex
idx (Name ByteString
name) a
x = (State -> IO Bool) -> LuaE e Bool
forall a e. (State -> IO a) -> LuaE e a
liftLua ((State -> IO Bool) -> LuaE e Bool)
-> (State -> IO Bool) -> LuaE e Bool
forall a b. (a -> b) -> a -> b
$ \State
l ->
  ByteString -> (CString -> IO Bool) -> IO Bool
forall a. ByteString -> (CString -> IO a) -> IO a
B.useAsCString ByteString
name ((CString -> IO Bool) -> IO Bool)
-> (CString -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \CString
namePtr ->
  State -> StackIndex -> CString -> a -> IO Bool
forall a. State -> StackIndex -> CString -> a -> IO Bool
hslua_putuserdata State
l StackIndex
idx CString
namePtr a
x
{-# INLINABLE putuserdata #-}