{-# LINE 1 "src/Foreign/Lua/Core/Auxiliary.hsc" #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-|
Module      : Foreign.Lua.Core.Auxiliary
Copyright   : © 2007–2012 Gracjan Polak,
                2012–2016 Ömer Sinan Ağacan,
                2017-2019 Albert Krewinkel
License     : MIT
Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de>
Stability   : beta
Portability : non-portable (depends on GHC)

Wrappers for the auxiliary library.
-}
module Foreign.Lua.Core.Auxiliary
  ( dostring
  , dofile
  , getmetafield
  , getmetatable'
  , getsubtable
  , loadbuffer
  , loadfile
  , loadstring
  , newmetatable
  , newstate
  , tostring'
  , traceback
  -- * References
  , getref
  , ref
  , unref
  -- * Registry fields
  , 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


--------------------------------------------------------------------------------
-- * The Auxiliary Library

-- | Key, in the registry, for table of loaded modules.
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" #-}

-- | Key, in the registry, for table of preloaded loaders.
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" #-}

-- | Loads and runs the given string.
--
-- Returns @'OK'@ on success, or an error if either loading of the string or
-- calling of the thunk failed.
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

-- | Loads and runs the given file. Note that the filepath is interpreted by
-- Haskell, not Lua. The resulting chunk is named using the UTF8 encoded
-- filepath.
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

-- | Pushes onto the stack the field @e@ from the metatable of the object at
-- index @obj@ and returns the type of the pushed value. If the object does not
-- have a metatable, or if the metatable does not have this field, pushes
-- nothing and returns TypeNil.
getmetafield :: StackIndex -- ^ obj
             -> String     -- ^ e
             -> 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

-- | Pushes onto the stack the metatable associated with name @tname@ in the
-- registry (see @newmetatable@) (@nil@ if there is no metatable associated
-- with that name). Returns the type of the pushed value.
getmetatable' :: String -- ^ tname
              -> 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

-- | Push referenced value from the table at the given index.
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'))

-- | Ensures that the value @t[fname]@, where @t@ is the value at index @idx@,
-- is a table, and pushes that table onto the stack. Returns True if it finds a
-- previous table there and False if it creates a new table.
getsubtable :: StackIndex -> String -> Lua Bool
getsubtable :: StackIndex -> String -> Lua Bool
getsubtable StackIndex
idx String
fname = do
  -- This is a reimplementation of luaL_getsubtable from lauxlib.c.
  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 -- copy to be left at top
      StackIndex -> String -> Lua ()
Lua.setfield StackIndex
idx' String
fname
      Bool -> Lua Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

-- | Loads a ByteString as a Lua chunk.
--
-- This function returns the same results as @'load'@. @name@ is the chunk name,
-- used for debug information and error messages. Note that @name@ is used as a
-- C string, so it may not contain null-bytes.
--
-- See <https://www.lua.org/manual/5.3/manual.html#luaL_loadbuffer luaL_loadbuffer>.
loadbuffer :: ByteString -- ^ Program to load
           -> String     -- ^ chunk name
           -> 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


-- | Loads a file as a Lua chunk. This function uses @lua_load@ (see @'load'@)
-- to load the chunk in the file named filename. The first line in the file is
-- ignored if it starts with a @#@.
--
-- The string mode works as in function @'load'@.
--
-- This function returns the same results as @'load'@, but it has an extra error
-- code @'ErrFile'@ for file-related errors (e.g., it cannot open or read the
-- file).
--
-- As @'load'@, this function only loads the chunk; it does not run it.
--
-- Note that the file is opened by Haskell, not Lua.
--
-- See <https://www.lua.org/manual/5.3/manual.html#luaL_loadfile luaL_loadfile>.
loadfile :: FilePath -- ^ filename
         -> 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)


-- | Loads a string as a Lua chunk. This function uses @lua_load@ to load the
-- chunk in the given ByteString. The given string may not contain any NUL
-- characters.
--
-- This function returns the same results as @lua_load@ (see @'load'@).
--
-- Also as @'load'@, this function only loads the chunk; it does not run it.
--
-- See <https://www.lua.org/manual/5.3/manual.html#luaL_loadstring luaL_loadstring>.
loadstring :: ByteString -> Lua Status
loadstring :: ByteString -> Lua Status
loadstring ByteString
s = ByteString -> String -> Lua Status
loadbuffer ByteString
s (ByteString -> String
Utf8.toString ByteString
s)


-- | If the registry already has the key tname, returns @False@. Otherwise,
-- creates a new table to be used as a metatable for userdata, adds to this new
-- table the pair @__name = tname@, adds to the registry the pair @[tname] = new
-- table@, and returns @True@. (The entry @__name@ is used by some
-- error-reporting functions.)
--
-- In both cases pushes onto the stack the final value associated with @tname@ in
-- the registry.
--
-- The value of @tname@ is used as a C string and hence must not contain null
-- bytes.
--
-- See also:
-- <https://www.lua.org/manual/5.3/manual.html#luaL_newmetatable luaL_newmetatable>.
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


-- | Creates a new Lua state. It calls @'lua_newstate'@ with an allocator based
-- on the standard C @realloc@ function and then sets a panic function (see
-- <https://www.lua.org/manual/5.3/manual.html#4.6 §4.6> of the Lua 5.3
-- Reference Manual) that prints an error message to the standard error output
-- in case of fatal errors.
--
-- See also:
-- <https://www.lua.org/manual/5.3/manual.html#luaL_newstate luaL_newstate>.
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


-- | Creates and returns a reference, in the table at index @t@, for the object
-- at the top of the stack (and pops the object).
--
-- A reference is a unique integer key. As long as you do not manually add
-- integer keys into table @t@, @ref@ ensures the uniqueness of the key it
-- returns. You can retrieve an object referred by reference @r@ by calling
-- @rawgeti t r@. Function @'unref'@ frees a reference and its associated
-- object.
--
-- If the object at the top of the stack is nil, @'ref'@ returns the constant
-- @'refnil'@. The constant @'noref'@ is guaranteed to be different from any
-- reference returned by @'ref'@.
--
-- See also: <https://www.lua.org/manual/5.3/manual.html#luaL_ref luaL_ref>.
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


-- | Converts any Lua value at the given index to a @'ByteString'@ in a
-- reasonable format. The resulting string is pushed onto the stack and also
-- returned by the function.
--
-- If the value has a metatable with a @__tostring@ field, then @tolstring'@
-- calls the corresponding metamethod with the value as argument, and uses the
-- result of the call as its result.
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)


-- | Creates and pushes a traceback of the stack L1. If a message is given it
-- appended at the beginning of the traceback. The level parameter tells at
-- which level to start the traceback.
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 ()


-- | Releases reference @'ref'@ from the table at index @idx@ (see @'ref'@). The
-- entry is removed from the table, so that the referred object can be
-- collected. The reference @'ref'@ is also freed to be used again.
--
-- See also:
-- <https://www.lua.org/manual/5.3/manual.html#luaL_unref luaL_unref>.
unref :: StackIndex -- ^ idx
      -> Reference  -- ^ ref
      -> 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 ()