{-|
Module      : HsLua.Core.Closures
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)

Expose Haskell functions as Lua closures.
-}
module HsLua.Core.Closures
  ( pushPreCFunction
  , pushHaskellFunction
  ) where

import Prelude hiding (error)
import HsLua.Core.Error (LuaError (..))
import HsLua.Core.Primary (error)
import HsLua.Core.Types (LuaE, PreCFunction, HaskellFunction, liftLua, runWith)
import Lua.Call (hslua_pushhsfunction)
import qualified Control.Monad.Catch as Catch

-- | Converts a pre C function to a Lua function and pushes it to the
-- stack.
--
-- Pre C functions collect parameters from the stack and return a @CInt@
-- that represents number of return values left on the stack.
-- See 'Lua.CFunction' for more info.
pushPreCFunction :: PreCFunction -> LuaE e ()
pushPreCFunction :: PreCFunction -> LuaE e ()
pushPreCFunction PreCFunction
preCFn = (State -> IO ()) -> LuaE e ()
forall a e. (State -> IO a) -> LuaE e a
liftLua ((State -> IO ()) -> LuaE e ()) -> (State -> IO ()) -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ \State
l ->
  State -> PreCFunction -> IO ()
hslua_pushhsfunction State
l PreCFunction
preCFn
{-# INLINABLE pushPreCFunction #-}

-- | Pushes Haskell function as a callable userdata. All values created
-- will be garbage collected. The function should behave similar to a
-- 'CFunction'.
--
-- Error conditions should be indicated by raising a catchable exception
-- or by returning the result of @'Lua.error'@.
--
-- Example:
--
-- > mod23 :: Lua NumResults
-- > mod23 = do
-- >   mn <- tointeger (nthBottom 1)
-- >   case mn of
-- >     Nothing -> pushstring "expected an integer" *> error
-- >     Just n  -> pushinteger (n `mod` 23)
-- > pushHaskellFunction mod23
-- > setglobal "mod23"
pushHaskellFunction :: LuaError e => HaskellFunction e -> LuaE e ()
pushHaskellFunction :: HaskellFunction e -> LuaE e ()
pushHaskellFunction HaskellFunction e
fn = do
  let preCFn :: PreCFunction
preCFn State
l = State -> HaskellFunction e -> IO NumResults
forall e a. State -> LuaE e a -> IO a
runWith State
l (HaskellFunction e -> HaskellFunction e
forall e. LuaError e => HaskellFunction e -> HaskellFunction e
exceptionToError HaskellFunction e
fn)
  PreCFunction -> LuaE e ()
forall e. PreCFunction -> LuaE e ()
pushPreCFunction PreCFunction
preCFn
{-# INLINABLE pushHaskellFunction #-}

exceptionToError :: LuaError e => HaskellFunction e -> HaskellFunction e
exceptionToError :: HaskellFunction e -> HaskellFunction e
exceptionToError HaskellFunction e
op = HaskellFunction e
op HaskellFunction e -> (e -> HaskellFunction e) -> HaskellFunction e
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`Catch.catch` \e
e -> e -> LuaE e ()
forall e. LuaError e => e -> LuaE e ()
pushException e
e LuaE e () -> HaskellFunction e -> HaskellFunction e
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> HaskellFunction e
forall e. LuaE e NumResults
error
{-# INLINABLE exceptionToError #-}