{-# LANGUAGE CPP #-}
{-|
Module      : Foreign.Lua.Raw.Call
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)

Raw bindings to function call helpers.
-}
module Foreign.Lua.Raw.Call
  ( HsFunction
  , hslua_newhsfunction
  , hslua_pushhsfunction
  ) where

import Foreign.C (CInt (CInt))
import Foreign.Ptr (Ptr, castPtr, nullPtr)
import Foreign.StablePtr (StablePtr, deRefStablePtr, newStablePtr)
import Foreign.Storable (peek)
import Foreign.Lua.Raw.Types
  ( NumResults (NumResults)
  , State (State)
  )

#ifdef ALLOW_UNSAFE_GC
#define SAFTY unsafe
#else
#define SAFTY safe
#endif

-- | Type of raw Haskell functions that can be made into
-- 'CFunction's.
type HsFunction = State -> IO NumResults

-- | Retrieve the pointer to a Haskell function from the wrapping
-- userdata object.
foreign import ccall SAFTY "hslua.h hslua_hs_fun_ptr"
  hslua_hs_fun_ptr :: State -> IO (Ptr ())

-- | Pushes a new C function created from an 'HsFunction'.
foreign import ccall SAFTY "hslua.h hslua_newhsfunction"
  hslua_newhsfunction :: State -> StablePtr a -> IO ()

hslua_pushhsfunction :: State -> HsFunction -> IO ()
hslua_pushhsfunction :: State -> HsFunction -> IO ()
hslua_pushhsfunction State
l HsFunction
preCFn =
  HsFunction -> IO (StablePtr HsFunction)
forall a. a -> IO (StablePtr a)
newStablePtr HsFunction
preCFn IO (StablePtr HsFunction)
-> (StablePtr HsFunction -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= State -> StablePtr HsFunction -> IO ()
forall a. State -> StablePtr a -> IO ()
hslua_newhsfunction State
l
{-# INLINABLE hslua_pushhsfunction #-}

-- | Call the Haskell function stored in the userdata. This
-- function is exported as a C function, as the C code uses it as
-- the @__call@ value of the wrapping userdata metatable.
hslua_call_wrapped_hs_fun :: HsFunction
hslua_call_wrapped_hs_fun :: HsFunction
hslua_call_wrapped_hs_fun State
l = do
  Ptr ()
udPtr <- State -> IO (Ptr ())
hslua_hs_fun_ptr State
l
  if Ptr ()
udPtr Ptr () -> Ptr () -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr ()
forall a. Ptr a
nullPtr
    then [Char] -> IO NumResults
forall a. HasCallStack => [Char] -> a
error [Char]
"Cannot call function; corrupted Lua object!"
    else do
      HsFunction
fn <- Ptr (StablePtr HsFunction) -> IO (StablePtr HsFunction)
forall a. Storable a => Ptr a -> IO a
peek (Ptr () -> Ptr (StablePtr HsFunction)
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
udPtr) IO (StablePtr HsFunction)
-> (StablePtr HsFunction -> IO HsFunction) -> IO HsFunction
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= StablePtr HsFunction -> IO HsFunction
forall a. StablePtr a -> IO a
deRefStablePtr
      HsFunction
fn State
l

foreign export ccall hslua_call_wrapped_hs_fun :: HsFunction