{-# LINE 1 "src/Foreign/Lua/Core/Auxiliary.hsc" #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Foreign.Lua.Core.Auxiliary
( dostring
, dofile
, getmetafield
, getmetatable'
, getsubtable
, loadbuffer
, loadfile
, loadstring
, newmetatable
, newstate
, tostring'
, traceback
, getref
, ref
, unref
, loadedTableRegistryField
, preloadTableRegistryField
) where
import Control.Exception (IOException, try)
import Data.ByteString (ByteString)
import Data.Monoid ((<>))
import Foreign.C ( CChar, CInt (CInt), CSize (CSize), CString, withCString )
import Foreign.Lua.Core.Constants (multret, registryindex)
import Foreign.Lua.Core.Error (hsluaErrorRegistryField, throwTopMessage)
import Foreign.Lua.Core.Types (Lua, Reference, StackIndex, Status, liftLua)
import Foreign.Marshal.Alloc (alloca)
import Foreign.Ptr
import qualified Data.ByteString as B
import qualified Foreign.Lua.Core.Functions as Lua
import qualified Foreign.Lua.Core.Types as Lua
import qualified Foreign.Lua.Utf8 as Utf8
import qualified Foreign.Storable as Storable
{-# LINE 54 "src/Foreign/Lua/Core/Auxiliary.hsc" #-}
import System.IO.Unsafe (unsafePerformIO)
import qualified Foreign.C as C
{-# LINE 57 "src/Foreign/Lua/Core/Auxiliary.hsc" #-}
#ifdef ALLOW_UNSAFE_GC
#define SAFTY unsafe
#else
#define SAFTY safe
#endif
loadedTableRegistryField :: String
{-# LINE 73 "src/Foreign/Lua/Core/Auxiliary.hsc" #-}
loadedTableRegistryField :: String
loadedTableRegistryField = IO String -> String
forall a. IO a -> a
unsafePerformIO (CString -> IO String
C.peekCString CString
c_loaded_table)
{-# NOINLINE loadedTableRegistryField #-}
foreign import capi "lauxlib.h value LUA_LOADED_TABLE"
c_loaded_table :: CString
{-# LINE 79 "src/Foreign/Lua/Core/Auxiliary.hsc" #-}
preloadTableRegistryField :: String
{-# LINE 85 "src/Foreign/Lua/Core/Auxiliary.hsc" #-}
preloadTableRegistryField :: String
preloadTableRegistryField = IO String -> String
forall a. IO a -> a
unsafePerformIO (CString -> IO String
C.peekCString CString
c_preload_table)
{-# NOINLINE preloadTableRegistryField #-}
foreign import capi "lauxlib.h value LUA_PRELOAD_TABLE"
c_preload_table :: CString
{-# LINE 91 "src/Foreign/Lua/Core/Auxiliary.hsc" #-}
dostring :: ByteString -> Lua Status
dostring :: ByteString -> Lua Status
dostring ByteString
s = do
Status
loadRes <- ByteString -> Lua Status
loadstring ByteString
s
if Status
loadRes Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
== Status
Lua.OK
then NumArgs -> NumResults -> Maybe StackIndex -> Lua Status
Lua.pcall NumArgs
0 NumResults
multret Maybe StackIndex
forall a. Maybe a
Nothing
else Status -> Lua Status
forall (m :: * -> *) a. Monad m => a -> m a
return Status
loadRes
dofile :: FilePath -> Lua Status
dofile :: String -> Lua Status
dofile String
fp = do
Status
loadRes <- String -> Lua Status
loadfile String
fp
if Status
loadRes Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
== Status
Lua.OK
then NumArgs -> NumResults -> Maybe StackIndex -> Lua Status
Lua.pcall NumArgs
0 NumResults
multret Maybe StackIndex
forall a. Maybe a
Nothing
else Status -> Lua Status
forall (m :: * -> *) a. Monad m => a -> m a
return Status
loadRes
getmetafield :: StackIndex
-> String
-> Lua Lua.Type
getmetafield :: StackIndex -> String -> Lua Type
getmetafield StackIndex
obj String
e = (State -> IO Type) -> Lua Type
forall a. (State -> IO a) -> Lua a
liftLua ((State -> IO Type) -> Lua Type) -> (State -> IO Type) -> Lua Type
forall a b. (a -> b) -> a -> b
$ \State
l ->
String -> (CString -> IO Type) -> IO Type
forall a. String -> (CString -> IO a) -> IO a
withCString String
e ((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
foreign import capi SAFTY "lauxlib.h luaL_getmetafield"
luaL_getmetafield :: Lua.State -> StackIndex -> CString -> IO Lua.TypeCode
getmetatable' :: String
-> Lua Lua.Type
getmetatable' :: String -> Lua Type
getmetatable' String
tname = (State -> IO Type) -> Lua Type
forall a. (State -> IO a) -> Lua a
liftLua ((State -> IO Type) -> Lua Type) -> (State -> IO Type) -> Lua Type
forall a b. (a -> b) -> a -> b
$ \State
l ->
String -> (CString -> IO Type) -> IO Type
forall a. String -> (CString -> IO a) -> IO a
withCString String
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
foreign import capi SAFTY "lauxlib.h luaL_getmetatable"
luaL_getmetatable :: Lua.State -> CString -> IO Lua.TypeCode
getref :: StackIndex -> Reference -> Lua ()
getref :: StackIndex -> Reference -> Lua ()
getref StackIndex
idx Reference
ref' = StackIndex -> Integer -> Lua ()
Lua.rawgeti StackIndex
idx (CInt -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Reference -> CInt
Lua.fromReference Reference
ref'))
getsubtable :: StackIndex -> String -> Lua Bool
getsubtable :: StackIndex -> String -> Lua Bool
getsubtable StackIndex
idx String
fname = do
StackIndex
idx' <- StackIndex -> Lua StackIndex
Lua.absindex StackIndex
idx
ByteString -> Lua ()
Lua.pushstring (String -> ByteString
Utf8.fromString String
fname)
StackIndex -> Lua ()
Lua.gettable StackIndex
idx'
Bool
isTbl <- StackIndex -> Lua Bool
Lua.istable StackIndex
Lua.stackTop
if Bool
isTbl
then Bool -> Lua Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
else do
StackIndex -> Lua ()
Lua.pop StackIndex
1
Lua ()
Lua.newtable
StackIndex -> Lua ()
Lua.pushvalue StackIndex
Lua.stackTop
StackIndex -> String -> Lua ()
Lua.setfield StackIndex
idx' String
fname
Bool -> Lua Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
loadbuffer :: ByteString
-> String
-> Lua Status
loadbuffer :: ByteString -> String -> Lua Status
loadbuffer ByteString
bs String
name = (State -> IO Status) -> Lua Status
forall a. (State -> IO a) -> Lua a
liftLua ((State -> IO Status) -> Lua Status)
-> (State -> IO Status) -> Lua Status
forall a b. (a -> b) -> a -> b
$ \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
$ \(CString
str, Int
len) ->
String -> (CString -> IO Status) -> IO Status
forall a. String -> (CString -> IO a) -> IO a
withCString String
name
((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))
foreign import capi SAFTY "lauxlib.h luaL_loadbuffer"
luaL_loadbuffer :: Lua.State -> Ptr CChar -> CSize -> CString
-> IO Lua.StatusCode
loadfile :: FilePath
-> Lua Status
loadfile :: String -> Lua Status
loadfile String
fp = IO (Either IOException ByteString)
-> Lua (Either IOException ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
Lua.liftIO IO (Either IOException ByteString)
contentOrError Lua (Either IOException ByteString)
-> (Either IOException ByteString -> Lua Status) -> Lua Status
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Right ByteString
script -> ByteString -> String -> Lua Status
loadbuffer ByteString
script (String
"@" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
fp)
Left IOException
e -> do
ByteString -> Lua ()
Lua.pushstring (String -> ByteString
Utf8.fromString (IOException -> String
forall a. Show a => a -> String
show IOException
e))
Status -> Lua Status
forall (m :: * -> *) a. Monad m => a -> m a
return Status
Lua.ErrFile
where
contentOrError :: IO (Either IOException ByteString)
contentOrError :: IO (Either IOException ByteString)
contentOrError = IO ByteString -> IO (Either IOException ByteString)
forall e a. Exception e => IO a -> IO (Either e a)
try (String -> IO ByteString
B.readFile String
fp)
loadstring :: ByteString -> Lua Status
loadstring :: ByteString -> Lua Status
loadstring ByteString
s = ByteString -> String -> Lua Status
loadbuffer ByteString
s (ByteString -> String
Utf8.toString ByteString
s)
newmetatable :: String -> Lua Bool
newmetatable :: String -> Lua Bool
newmetatable String
tname = (State -> IO Bool) -> Lua Bool
forall a. (State -> IO a) -> Lua a
liftLua ((State -> IO Bool) -> Lua Bool) -> (State -> IO Bool) -> Lua Bool
forall a b. (a -> b) -> a -> b
$ \State
l ->
LuaBool -> Bool
Lua.fromLuaBool (LuaBool -> Bool) -> IO LuaBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> (CString -> IO LuaBool) -> IO LuaBool
forall a. String -> (CString -> IO a) -> IO a
withCString String
tname (State -> CString -> IO LuaBool
luaL_newmetatable State
l)
foreign import ccall SAFTY "lauxlib.h luaL_newmetatable"
luaL_newmetatable :: Lua.State -> CString -> IO Lua.LuaBool
newstate :: IO Lua.State
newstate :: IO State
newstate = do
State
l <- IO State
luaL_newstate
State -> Lua State -> IO State
forall a. State -> Lua a -> IO a
Lua.runWith State
l (Lua State -> IO State) -> Lua State -> IO State
forall a b. (a -> b) -> a -> b
$ do
Int -> Int -> Lua ()
Lua.createtable Int
0 Int
0
StackIndex -> String -> Lua ()
Lua.setfield StackIndex
registryindex String
hsluaErrorRegistryField
State -> Lua State
forall (m :: * -> *) a. Monad m => a -> m a
return State
l
foreign import ccall unsafe "lauxlib.h luaL_newstate"
luaL_newstate :: IO Lua.State
ref :: StackIndex -> Lua Reference
ref :: StackIndex -> Lua Reference
ref StackIndex
t = (State -> IO Reference) -> Lua Reference
forall a. (State -> IO a) -> Lua a
liftLua ((State -> IO Reference) -> Lua Reference)
-> (State -> IO Reference) -> Lua Reference
forall a b. (a -> b) -> a -> b
$ \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
foreign import ccall SAFTY "lauxlib.h luaL_ref"
luaL_ref :: Lua.State -> StackIndex -> IO CInt
tostring' :: StackIndex -> Lua B.ByteString
tostring' :: StackIndex -> Lua ByteString
tostring' StackIndex
n = (State -> IO ByteString) -> Lua ByteString
forall a. (State -> IO a) -> Lua a
liftLua ((State -> IO ByteString) -> Lua ByteString)
-> (State -> IO ByteString) -> Lua ByteString
forall a b. (a -> b) -> a -> b
$ \State
l -> (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
$ \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 -> Lua ByteString -> IO ByteString
forall a. State -> Lua a -> IO a
Lua.runWith State
l Lua ByteString
forall a. Lua a
throwTopMessage
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)
foreign import ccall safe "error-conversion.h hsluaL_tolstring"
hsluaL_tolstring :: Lua.State -> StackIndex -> Ptr CSize -> IO (Ptr CChar)
traceback :: Lua.State -> Maybe String -> Int -> Lua ()
traceback :: State -> Maybe String -> Int -> Lua ()
traceback State
l1 Maybe String
msg Int
level = (State -> IO ()) -> Lua ()
forall a. (State -> IO a) -> Lua a
liftLua ((State -> IO ()) -> Lua ()) -> (State -> IO ()) -> Lua ()
forall a b. (a -> b) -> a -> b
$ \State
l ->
case Maybe String
msg of
Maybe String
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 String
msg' -> String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
msg' ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \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)
foreign import capi unsafe "lauxlib.h luaL_traceback"
luaL_traceback :: Lua.State -> Lua.State -> CString -> CInt -> IO ()
unref :: StackIndex
-> Reference
-> Lua ()
unref :: StackIndex -> Reference -> Lua ()
unref StackIndex
idx Reference
r = (State -> IO ()) -> Lua ()
forall a. (State -> IO a) -> Lua a
liftLua ((State -> IO ()) -> Lua ()) -> (State -> IO ()) -> Lua ()
forall a b. (a -> b) -> a -> b
$ \State
l ->
State -> StackIndex -> CInt -> IO ()
luaL_unref State
l StackIndex
idx (Reference -> CInt
Lua.fromReference Reference
r)
foreign import ccall SAFTY "lauxlib.h luaL_unref"
luaL_unref :: Lua.State -> StackIndex -> CInt -> IO ()