{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module HsLua.Core.Auxiliary
(
checkstack'
, dostring
, dofile
, getmetafield
, getmetatable'
, getsubtable
, loadbuffer
, loadfile
, loadstring
, newmetatable
, newstate
, requiref
, tostring'
, traceback
, where'
, getref
, ref
, unref
, loaded
, preload
) where
import Control.Monad ((<$!>))
import Data.ByteString (ByteString)
import Data.String (IsString (fromString))
import HsLua.Core.Error
import HsLua.Core.Types
(LuaE, Name (Name), Status, StackIndex, liftLua, multret, runWith)
import Lua (top)
import Lua.Auxiliary
import Lua.Ersatz.Auxiliary
import Foreign.C (withCString)
import Foreign.Marshal.Alloc (alloca)
import Foreign.Ptr
import qualified Data.ByteString as B
import qualified HsLua.Core.Primary as Lua
import qualified HsLua.Core.Types as Lua
import qualified Foreign.Storable as Storable
checkstack' :: LuaError e
=> Int
-> String
-> LuaE e ()
checkstack' :: Int -> String -> LuaE e ()
checkstack' sz :: Int
sz msg :: String
msg =
Int -> LuaE e Bool
forall e. Int -> LuaE e Bool
Lua.checkstack Int
sz LuaE e Bool -> (Bool -> LuaE e ()) -> LuaE e ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
True -> () -> LuaE e ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
False -> String -> LuaE e ()
forall e a. LuaError e => String -> LuaE e a
failLua (String -> LuaE e ()) -> String -> LuaE e ()
forall a b. (a -> b) -> a -> b
$
if String
msg String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== ""
then "stack overflow"
else "stack overflow (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++ ")"
dostring :: ByteString -> LuaE e Status
dostring :: ByteString -> LuaE e Status
dostring s :: ByteString
s = ByteString -> LuaE e Status
forall e. ByteString -> LuaE e Status
loadstring ByteString
s LuaE e Status -> (Status -> LuaE e Status) -> LuaE e Status
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Lua.OK -> NumArgs -> NumResults -> Maybe StackIndex -> LuaE e Status
forall e.
NumArgs -> NumResults -> Maybe StackIndex -> LuaE e Status
Lua.pcall 0 NumResults
multret Maybe StackIndex
forall a. Maybe a
Nothing
err :: Status
err -> Status -> LuaE e Status
forall (m :: * -> *) a. Monad m => a -> m a
return Status
err
{-# INLINABLE dostring #-}
dofile :: FilePath -> LuaE e Status
dofile :: String -> LuaE e Status
dofile fp :: String
fp = String -> LuaE e Status
forall e. String -> LuaE e Status
loadfile String
fp LuaE e Status -> (Status -> LuaE e Status) -> LuaE e Status
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Lua.OK -> NumArgs -> NumResults -> Maybe StackIndex -> LuaE e Status
forall e.
NumArgs -> NumResults -> Maybe StackIndex -> LuaE e Status
Lua.pcall 0 NumResults
multret Maybe StackIndex
forall a. Maybe a
Nothing
err :: Status
err -> Status -> LuaE e Status
forall (m :: * -> *) a. Monad m => a -> m a
return Status
err
{-# INLINABLE dofile #-}
getmetafield :: StackIndex
-> Name
-> LuaE e Lua.Type
getmetafield :: StackIndex -> Name -> LuaE e Type
getmetafield obj :: StackIndex
obj (Name name :: ByteString
name) = (State -> IO Type) -> LuaE e Type
forall a e. (State -> IO a) -> LuaE e a
liftLua ((State -> IO Type) -> LuaE e Type)
-> (State -> IO Type) -> LuaE e Type
forall a b. (a -> b) -> a -> b
$ \l :: State
l ->
ByteString -> (CString -> IO Type) -> IO Type
forall a. ByteString -> (CString -> IO a) -> IO a
B.useAsCString ByteString
name ((CString -> IO Type) -> IO Type)
-> (CString -> IO Type) -> IO Type
forall a b. (a -> b) -> a -> b
$! (TypeCode -> Type) -> IO TypeCode -> IO Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TypeCode -> Type
Lua.toType (IO TypeCode -> IO Type)
-> (CString -> IO TypeCode) -> CString -> IO Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> StackIndex -> CString -> IO TypeCode
luaL_getmetafield State
l StackIndex
obj
{-# INLINABLE getmetafield #-}
getmetatable' :: Name
-> LuaE e Lua.Type
getmetatable' :: Name -> LuaE e Type
getmetatable' (Name tname :: ByteString
tname) = (State -> IO Type) -> LuaE e Type
forall a e. (State -> IO a) -> LuaE e a
liftLua ((State -> IO Type) -> LuaE e Type)
-> (State -> IO Type) -> LuaE e Type
forall a b. (a -> b) -> a -> b
$ \l :: State
l ->
ByteString -> (CString -> IO Type) -> IO Type
forall a. ByteString -> (CString -> IO a) -> IO a
B.useAsCString ByteString
tname ((CString -> IO Type) -> IO Type)
-> (CString -> IO Type) -> IO Type
forall a b. (a -> b) -> a -> b
$ (TypeCode -> Type) -> IO TypeCode -> IO Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TypeCode -> Type
Lua.toType (IO TypeCode -> IO Type)
-> (CString -> IO TypeCode) -> CString -> IO Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> CString -> IO TypeCode
luaL_getmetatable State
l
{-# INLINABLE getmetatable' #-}
getref :: LuaError e => StackIndex -> Reference -> LuaE e Lua.Type
getref :: StackIndex -> Reference -> LuaE e Type
getref idx :: StackIndex
idx ref' :: Reference
ref' = StackIndex -> Integer -> LuaE e Type
forall e. LuaError e => StackIndex -> Integer -> LuaE e Type
Lua.rawgeti StackIndex
idx (CInt -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Reference -> CInt
Lua.fromReference Reference
ref'))
{-# INLINABLE getref #-}
getsubtable :: LuaError e
=> StackIndex
-> Name
-> LuaE e Bool
getsubtable :: StackIndex -> Name -> LuaE e Bool
getsubtable idx :: StackIndex
idx fname :: Name
fname@(Name namestr :: ByteString
namestr) = do
StackIndex
idx' <- StackIndex -> LuaE e StackIndex
forall e. StackIndex -> LuaE e StackIndex
Lua.absindex StackIndex
idx
ByteString -> LuaE e ()
forall e. ByteString -> LuaE e ()
Lua.pushstring ByteString
namestr
StackIndex -> LuaE e Type
forall e. LuaError e => StackIndex -> LuaE e Type
Lua.gettable StackIndex
idx' LuaE e Type -> (Type -> LuaE e Bool) -> LuaE e Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Lua.TypeTable -> Bool -> LuaE e Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
_ -> do
Int -> LuaE e ()
forall e. Int -> LuaE e ()
Lua.pop 1
LuaE e ()
forall e. LuaE e ()
Lua.newtable
StackIndex -> LuaE e ()
forall e. StackIndex -> LuaE e ()
Lua.pushvalue StackIndex
top
StackIndex -> Name -> LuaE e ()
forall e. LuaError e => StackIndex -> Name -> LuaE e ()
Lua.setfield StackIndex
idx' Name
fname
Bool -> LuaE e Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
{-# INLINABLE getsubtable #-}
loadbuffer :: ByteString
-> Name
-> LuaE e Status
loadbuffer :: ByteString -> Name -> LuaE e Status
loadbuffer bs :: ByteString
bs (Name name :: ByteString
name) = (State -> IO Status) -> LuaE e Status
forall a e. (State -> IO a) -> LuaE e a
liftLua ((State -> IO Status) -> LuaE e Status)
-> (State -> IO Status) -> LuaE e Status
forall a b. (a -> b) -> a -> b
$ \l :: State
l ->
ByteString -> (CStringLen -> IO Status) -> IO Status
forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.useAsCStringLen ByteString
bs ((CStringLen -> IO Status) -> IO Status)
-> (CStringLen -> IO Status) -> IO Status
forall a b. (a -> b) -> a -> b
$ \(str :: CString
str, len :: Int
len) ->
ByteString -> (CString -> IO Status) -> IO Status
forall a. ByteString -> (CString -> IO a) -> IO a
B.useAsCString ByteString
name ((CString -> IO Status) -> IO Status)
-> (CString -> IO Status) -> IO Status
forall a b. (a -> b) -> a -> b
$!
(StatusCode -> Status) -> IO StatusCode -> IO Status
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StatusCode -> Status
Lua.toStatus (IO StatusCode -> IO Status)
-> (CString -> IO StatusCode) -> CString -> IO Status
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> CString -> CSize -> CString -> IO StatusCode
luaL_loadbuffer State
l CString
str (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
{-# INLINABLE loadbuffer #-}
loadfile :: FilePath
-> LuaE e Status
loadfile :: String -> LuaE e Status
loadfile fp :: String
fp = (State -> IO Status) -> LuaE e Status
forall a e. (State -> IO a) -> LuaE e a
liftLua ((State -> IO Status) -> LuaE e Status)
-> (State -> IO Status) -> LuaE e Status
forall a b. (a -> b) -> a -> b
$ \l :: State
l ->
String -> (CString -> IO Status) -> IO Status
forall a. String -> (CString -> IO a) -> IO a
withCString String
fp ((CString -> IO Status) -> IO Status)
-> (CString -> IO Status) -> IO Status
forall a b. (a -> b) -> a -> b
$! (StatusCode -> Status) -> IO StatusCode -> IO Status
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StatusCode -> Status
Lua.toStatus (IO StatusCode -> IO Status)
-> (CString -> IO StatusCode) -> CString -> IO Status
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> CString -> IO StatusCode
luaL_loadfile State
l
{-# INLINABLE loadfile #-}
loadstring :: ByteString -> LuaE e Status
loadstring :: ByteString -> LuaE e Status
loadstring s :: ByteString
s = ByteString -> Name -> LuaE e Status
forall e. ByteString -> Name -> LuaE e Status
loadbuffer ByteString
s (ByteString -> Name
Name ByteString
s)
{-# INLINE loadstring #-}
newmetatable :: Name -> LuaE e Bool
newmetatable :: Name -> LuaE e Bool
newmetatable (Name tname :: ByteString
tname) = (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
$ \l :: State
l ->
LuaBool -> Bool
Lua.fromLuaBool (LuaBool -> Bool) -> IO LuaBool -> IO Bool
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> ByteString -> (CString -> IO LuaBool) -> IO LuaBool
forall a. ByteString -> (CString -> IO a) -> IO a
B.useAsCString ByteString
tname (State -> CString -> IO LuaBool
luaL_newmetatable State
l)
{-# INLINABLE newmetatable #-}
newstate :: IO Lua.State
newstate :: IO State
newstate = IO State
hsluaL_newstate
{-# INLINE newstate #-}
ref :: StackIndex -> LuaE e Reference
ref :: StackIndex -> LuaE e Reference
ref t :: StackIndex
t = (State -> IO Reference) -> LuaE e Reference
forall a e. (State -> IO a) -> LuaE e a
liftLua ((State -> IO Reference) -> LuaE e Reference)
-> (State -> IO Reference) -> LuaE e Reference
forall a b. (a -> b) -> a -> b
$ \l :: State
l -> CInt -> Reference
Lua.toReference (CInt -> Reference) -> IO CInt -> IO Reference
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> State -> StackIndex -> IO CInt
luaL_ref State
l StackIndex
t
{-# INLINABLE ref #-}
requiref :: LuaError e
=> Name
-> Lua.CFunction
-> Bool
-> LuaE e ()
requiref :: Name -> CFunction -> Bool -> LuaE e ()
requiref (Name name :: ByteString
name) openf :: CFunction
openf glb :: Bool
glb = (State -> Ptr StatusCode -> IO ()) -> LuaE e ()
forall e a.
LuaError e =>
(State -> Ptr StatusCode -> IO a) -> LuaE e a
liftLuaThrow ((State -> Ptr StatusCode -> IO ()) -> LuaE e ())
-> (State -> Ptr StatusCode -> IO ()) -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ \l :: State
l status' :: Ptr StatusCode
status' ->
ByteString -> (CString -> IO ()) -> IO ()
forall a. ByteString -> (CString -> IO a) -> IO a
B.useAsCString ByteString
name ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \namePtr :: CString
namePtr ->
State -> CString -> CFunction -> LuaBool -> Ptr StatusCode -> IO ()
hsluaL_requiref State
l CString
namePtr CFunction
openf (Bool -> LuaBool
Lua.toLuaBool Bool
glb) Ptr StatusCode
status'
tostring' :: forall e. LuaError e => StackIndex -> LuaE e B.ByteString
tostring' :: StackIndex -> LuaE e ByteString
tostring' n :: StackIndex
n = do
State
l <- LuaE e State
forall e. LuaE e State
Lua.state
IO ByteString -> LuaE e ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
Lua.liftIO (IO ByteString -> LuaE e ByteString)
-> IO ByteString -> LuaE e ByteString
forall a b. (a -> b) -> a -> b
$ (Ptr CSize -> IO ByteString) -> IO ByteString
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CSize -> IO ByteString) -> IO ByteString)
-> (Ptr CSize -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \lenPtr :: Ptr CSize
lenPtr -> do
CString
cstr <- State -> StackIndex -> Ptr CSize -> IO CString
hsluaL_tolstring State
l StackIndex
n Ptr CSize
lenPtr
if CString
cstr CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
forall a. Ptr a
nullPtr
then State -> LuaE e ByteString -> IO ByteString
forall e a. State -> LuaE e a -> IO a
runWith @e State
l LuaE e ByteString
forall e a. LuaError e => LuaE e a
throwErrorAsException
else do
CSize
cstrLen <- Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
Storable.peek Ptr CSize
lenPtr
CStringLen -> IO ByteString
B.packCStringLen (CString
cstr, CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
cstrLen)
{-# INLINABLE tostring' #-}
traceback :: Lua.State -> Maybe ByteString -> Int -> LuaE e ()
traceback :: State -> Maybe ByteString -> Int -> LuaE e ()
traceback l1 :: State
l1 msg :: Maybe ByteString
msg level :: Int
level = (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
$ \l :: State
l ->
case Maybe ByteString
msg of
Nothing -> State -> State -> CString -> CInt -> IO ()
luaL_traceback State
l State
l1 CString
forall a. Ptr a
nullPtr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
level)
Just msg' :: ByteString
msg' -> ByteString -> (CString -> IO ()) -> IO ()
forall a. ByteString -> (CString -> IO a) -> IO a
B.useAsCString ByteString
msg' ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \cstr :: CString
cstr ->
State -> State -> CString -> CInt -> IO ()
luaL_traceback State
l State
l1 CString
cstr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
level)
{-# INLINABLE traceback #-}
unref :: StackIndex
-> Reference
-> LuaE e ()
unref :: StackIndex -> Reference -> LuaE e ()
unref idx :: StackIndex
idx r :: Reference
r = (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
$ \l :: State
l ->
State -> StackIndex -> CInt -> IO ()
luaL_unref State
l StackIndex
idx (Reference -> CInt
Lua.fromReference Reference
r)
{-# INLINABLE unref #-}
where' :: Int
-> LuaE e ()
where' :: Int -> LuaE e ()
where' lvl :: Int
lvl = (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
$ \l :: State
l -> State -> CInt -> IO ()
luaL_where State
l (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lvl)
{-# INLINABLE where' #-}
loaded :: Name
loaded :: Name
loaded = String -> Name
forall a. IsString a => String -> a
fromString String
loadedTableRegistryField
preload :: Name
preload :: Name
preload = String -> Name
forall a. IsString a => String -> a
fromString String
preloadTableRegistryField