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