{-|
Module      : HsLua.Core.Run
Copyright   : © 2007–2012 Gracjan Polak;
              © 2012–2016 Ömer Sinan Ağacan;
              © 2017-2023 Albert Krewinkel
License     : MIT
Maintainer  : Albert Krewinkel <tarleb@hslua.org>
Stability   : beta
Portability : non-portable (depends on GHC)

Helper functions to run 'LuaE' computations.
-}
module HsLua.Core.Run
  ( run
  , runEither
  , runWith
    -- * GCManaged state
  , GCManagedState
  , newGCManagedState
  , closeGCManagedState
  , withGCManagedState
  ) where

import Control.Exception (bracket, try)
import Control.Monad ((<$!>))
import Foreign.ForeignPtr
  (ForeignPtr, finalizeForeignPtr, newForeignPtr, withForeignPtr)
import HsLua.Core.Types (LuaE, runWith)
import Lua.Primary (lua_close_ptr)
import Lua (State (..))

import qualified Control.Monad.Catch as Catch
import qualified HsLua.Core.Auxiliary as Lua
import qualified HsLua.Core.Primary as Lua

-- | Run Lua computation using the default HsLua state as starting
-- point. Exceptions are masked, thus avoiding some issues when using
-- multiple threads. All exceptions are passed through; error handling
-- is the responsibility of the caller.
run :: LuaE e a -> IO a
run :: forall e a. LuaE e a -> IO a
run = (IO State
Lua.newstate forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
`bracket` State -> IO ()
Lua.close) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall e a. State -> LuaE e a -> IO a
runWith forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadMask m => m a -> m a
Catch.mask_
{-# INLINABLE run #-}

-- | Run the given Lua computation; exceptions raised in Haskell code are
-- caught, but other exceptions (user exceptions raised in Haskell, unchecked
-- type errors, etc.) are passed through.
runEither :: Catch.Exception e => LuaE e a -> IO (Either e a)
runEither :: forall e a. Exception e => LuaE e a -> IO (Either e a)
runEither = forall e a. Exception e => IO a -> IO (Either e a)
try forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. LuaE e a -> IO a
run
{-# INLINABLE runEither #-}

-- | Wrapper of a Lua state whose lifetime is managed by the Haskell
-- garbage collector and has a finalizer attached. This means that the
-- state does not have to be closed explicitly, but will be closed
-- automatically when the value is garbage collected in Haskell.
newtype GCManagedState = GCManagedState (ForeignPtr ())

-- | Creates a new Lua state that is under the control of the Haskell
-- garbage collector.
newGCManagedState :: IO GCManagedState
newGCManagedState :: IO GCManagedState
newGCManagedState = do
  (State Ptr ()
lptr) <- IO State
Lua.newstate
  ForeignPtr () -> GCManagedState
GCManagedState forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FunPtr (Ptr () -> IO ())
lua_close_ptr Ptr ()
lptr

-- | Closes the Lua state and runs all finalizers associated with it.
-- The state _may not_ be used after it has been closed.
closeGCManagedState :: GCManagedState -> IO ()
closeGCManagedState :: GCManagedState -> IO ()
closeGCManagedState (GCManagedState ForeignPtr ()
fptr) = forall a. ForeignPtr a -> IO ()
finalizeForeignPtr ForeignPtr ()
fptr

-- | Runs a Lua action with a state that's managed by GC.
withGCManagedState :: GCManagedState
                   -> LuaE e a
                   -> IO a
withGCManagedState :: forall e a. GCManagedState -> LuaE e a -> IO a
withGCManagedState (GCManagedState ForeignPtr ()
fptr) LuaE e a
action =
  forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
fptr forall a b. (a -> b) -> a -> b
$ \Ptr ()
lptr ->
    forall e a. State -> LuaE e a -> IO a
runWith (Ptr () -> State
State Ptr ()
lptr) LuaE e a
action