{-# 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 =
Int -> LuaE e Bool
forall e. Int -> LuaE e Bool
Lua.checkstack Int
sz LuaE e Bool -> (Bool -> LuaE e ()) -> LuaE e ()
forall a b. LuaE e a -> (a -> LuaE e b) -> LuaE e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True -> () -> LuaE e ()
forall a. a -> LuaE e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Bool
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
== String
""
then String
"stack overflow"
else String
"stack overflow (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
dostring :: ByteString -> LuaE e Status
dostring :: forall e. ByteString -> LuaE e Status
dostring 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 a b. LuaE e a -> (a -> LuaE e b) -> LuaE e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Status
Lua.OK -> NumArgs -> NumResults -> Maybe StackIndex -> LuaE e Status
forall e.
NumArgs -> NumResults -> Maybe StackIndex -> LuaE e Status
Lua.pcall NumArgs
0 NumResults
multret Maybe StackIndex
forall a. Maybe a
Nothing
Status
err -> Status -> LuaE e Status
forall a. a -> LuaE e a
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 = Maybe String -> LuaE e Status
forall e. Maybe String -> LuaE e Status
loadfile Maybe String
mfp LuaE e Status -> (Status -> LuaE e Status) -> LuaE e Status
forall a b. LuaE e a -> (a -> LuaE e b) -> LuaE e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Status
Lua.OK -> NumArgs -> NumResults -> Maybe StackIndex -> LuaE e Status
forall e.
NumArgs -> NumResults -> Maybe StackIndex -> LuaE e Status
Lua.pcall NumArgs
0 NumResults
multret Maybe StackIndex
forall a. Maybe a
Nothing
Status
err -> Status -> LuaE e Status
forall a. a -> LuaE e a
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) = (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
$ \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 a b. (a -> b) -> IO a -> IO b
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' :: forall e. Name -> LuaE e Type
getmetatable' (Name 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
$ \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 a b. (a -> b) -> IO a -> IO b
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 :: forall e. LuaError e => StackIndex -> Reference -> LuaE e Type
getref StackIndex
idx 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 :: forall e. LuaError e => StackIndex -> Name -> LuaE e Bool
getsubtable StackIndex
idx fname :: Name
fname@(Name 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 a b. LuaE e a -> (a -> LuaE e b) -> LuaE e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Type
Lua.TypeTable -> Bool -> LuaE e Bool
forall a. a -> LuaE e a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Type
_ -> do
Int -> LuaE e ()
forall e. Int -> LuaE e ()
Lua.pop Int
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 a. a -> LuaE e a
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) = (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
$ \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) ->
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 a b. (a -> b) -> IO a -> IO b
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 :: Maybe FilePath
-> LuaE e Status
loadfile :: forall e. Maybe String -> LuaE e Status
loadfile Maybe String
mfp = (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
$ \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 ->
TextEncoding -> String -> (CString -> IO Status) -> IO Status
forall a. TextEncoding -> String -> (CString -> IO a) -> IO a
GHC.withCString TextEncoding
fsEncoding 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 a b. (a -> b) -> IO a -> IO b
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
Maybe String
Nothing ->
StatusCode -> Status
Lua.toStatus (StatusCode -> Status) -> IO StatusCode -> IO Status
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> State -> CString -> IO StatusCode
luaL_loadfile State
l CString
forall a. Ptr a
nullPtr
{-# INLINABLE loadfile #-}
loadstring :: ByteString -> LuaE e Status
loadstring :: forall e. ByteString -> LuaE e Status
loadstring 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 :: forall e. Name -> LuaE e Bool
newmetatable (Name 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
$ \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 :: forall e. StackIndex -> LuaE e Reference
ref 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
$ \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 :: forall e. LuaError e => Name -> CFunction -> Bool -> LuaE e ()
requiref (Name ByteString
name) CFunction
openf 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
$ \State
l 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
$ \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 <- LuaE e State
forall e. LuaE e State
Lua.state
IO ByteString -> LuaE e ByteString
forall a. IO a -> LuaE e a
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
$ \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 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 :: forall e. State -> Maybe ByteString -> Int -> LuaE e ()
traceback State
l1 Maybe ByteString
msg 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
$ \State
l ->
case Maybe ByteString
msg of
Maybe ByteString
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 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
$ \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 :: forall e. StackIndex -> Reference -> LuaE e ()
unref StackIndex
idx 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
$ \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 = (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 -> 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