{-# LINE 1 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
{-
Copyright © 2007-2012 Gracjan Polak
Copyright © 2012-2016 Ömer Sinan Ağacan
Copyright © 2017 Albert Krewinkel

Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included in
all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
THE SOFTWARE.
-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-|
Module      : Foreign.Lua.Api.RawBindings
Copyright   : © 2007–2012 Gracjan Polak,
                2012–2016 Ömer Sinan Ağacan,
                2017 Albert Krewinkel
License     : MIT
Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de>
Stability   : beta
Portability : ForeignFunctionInterface

Haskell bindings to lua C API functions.
-}
module Foreign.Lua.Api.RawBindings where

import Foreign.C
import Foreign.Lua.Api.Types
import Foreign.Ptr



-- TODO: lua_getallocf, lua_setallocf
-- TODO: Debugger functions

-- Some of the Lua functions may call a Haskell function, and trigger
-- garbage collection, rescheduling etc. This means we must declare these
-- functions as 'safe'.


--------------------------------------------------------------------------------
-- * State manipulation

-- lua_newstate is currently not supported.

-- | See <https://www.lua.org/manual/5.3/manual.html#lua_close lua_close>
foreign import ccall "lua.h lua_close"
  lua_close :: LuaState -> IO ()

-- lua_newthread is currently not supported.


--------------------------------------------------------------------------------
-- * Basic stack manipulation


{-# LINE 70 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
-- | See <https://www.lua.org/manual/5.3/manual.html#lua_absindex lua_absindex>
foreign import ccall unsafe "lua.h lua_absindex"
  lua_absindex :: LuaState -> StackIndex -> IO StackIndex

{-# LINE 74 "src/Foreign/Lua/Api/RawBindings.hsc" #-}

-- | See <https://www.lua.org/manual/5.3/manual.html#lua_gettop lua_gettop>
foreign import ccall unsafe "lua.h lua_gettop"
  lua_gettop :: LuaState -> IO StackIndex

-- | See <https://www.lua.org/manual/5.3/manual.html#lua_settop lua_settop>

{-# LINE 81 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
foreign import ccall unsafe "lua.h lua_settop"

{-# LINE 85 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
  lua_settop :: LuaState -> StackIndex -> IO ()

-- | See <https://www.lua.org/manual/5.3/manual.html#lua_pushvalue lua_pushvalue>

{-# LINE 89 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
foreign import ccall unsafe "lua.h lua_pushvalue"

{-# LINE 93 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
  lua_pushvalue :: LuaState -> StackIndex -> IO ()


{-# LINE 96 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
-- | See <https://www.lua.org/manual/5.3/manual.html#lua_rotate lua_rotate>

{-# LINE 98 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
foreign import ccall unsafe "lua.h lua_rotate"

{-# LINE 102 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
  lua_rotate :: LuaState -> StackIndex -> CInt -> IO ()

-- | See <https://www.lua.org/manual/5.3/manual.html#lua_copy lua_copy>

{-# LINE 106 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
foreign import ccall unsafe "lua.h lua_copy"

{-# LINE 110 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
  lua_copy :: LuaState -> StackIndex -> StackIndex -> IO ()

{-# LINE 136 "src/Foreign/Lua/Api/RawBindings.hsc" #-}

-- | See <https://www.lua.org/manual/5.3/manual.html#lua_checkstack lua_checkstack>

{-# LINE 139 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
foreign import ccall unsafe "lua.h lua_checkstack"

{-# LINE 143 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
  lua_checkstack :: LuaState -> StackIndex -> IO LuaBool

-- lua_xmove is currently not supported.


--------------------------------------------------------------------------------
-- * Stack access functions

-- | See <https://www.lua.org/manual/5.3/manual.html#lua_isnumber lua_isnumber>

{-# LINE 153 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
foreign import ccall unsafe "lua.h lua_isnumber"

{-# LINE 157 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
  lua_isnumber :: LuaState -> StackIndex -> IO LuaBool

-- | See <https://www.lua.org/manual/5.3/manual.html#lua_isstring lua_isstring>

{-# LINE 161 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
foreign import ccall unsafe "lua.h lua_isstring"

{-# LINE 165 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
  lua_isstring :: LuaState -> StackIndex -> IO LuaBool

-- | See <https://www.lua.org/manual/5.3/manual.html#lua_iscfunction lua_iscfunction>

{-# LINE 169 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
foreign import ccall unsafe "lua.h lua_iscfunction"

{-# LINE 173 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
  lua_iscfunction :: LuaState -> StackIndex -> IO LuaBool

-- | See <https://www.lua.org/manual/5.3/manual.html#lua_isuserdata lua_isuserdata>

{-# LINE 177 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
foreign import ccall unsafe "lua.h lua_isuserdata"

{-# LINE 181 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
  lua_isuserdata :: LuaState -> StackIndex -> IO LuaBool

-- | See <https://www.lua.org/manual/5.3/manual.html#lua_type lua_type>

{-# LINE 185 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
foreign import ccall unsafe "lua.h lua_type"

{-# LINE 189 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
  lua_type :: LuaState -> StackIndex -> IO TypeCode

-- | See <https://www.lua.org/manual/5.3/manual.html#lua_typename lua_typename>

{-# LINE 193 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
foreign import ccall unsafe "lua.h lua_typename"

{-# LINE 197 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
  lua_typename :: LuaState -> TypeCode -> IO (Ptr CChar)

-- lua_compare is unsafe (might cause a longjmp), use hslua_compare instead.

{-# LINE 201 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
-- | Wrapper around <https://lua.org/manual/5.3/manual.html#lua_compare \
-- @lua_compare@> which catches any @longjmp@s.
foreign import ccall "safer-api.h hslua_compare"
  hslua_compare :: LuaState -> StackIndex -> StackIndex -> CInt
                -> IO (Failable LuaBool)

{-# LINE 215 "src/Foreign/Lua/Api/RawBindings.hsc" #-}

-- | See <https://www.lua.org/manual/5.3/manual.html#lua_rawequal lua_rawequal>

{-# LINE 218 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
foreign import ccall unsafe "lua.h lua_rawequal"

{-# LINE 222 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
  lua_rawequal :: LuaState -> StackIndex -> StackIndex -> IO LuaBool

--
-- Type coercion
--
-- | See <https://www.lua.org/manual/5.3/manual.html#lua_toboolean lua_toboolean>

{-# LINE 229 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
foreign import ccall unsafe "lua.h lua_toboolean"

{-# LINE 233 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
  lua_toboolean :: LuaState -> StackIndex -> IO StackIndex

-- | See <https://www.lua.org/manual/5.3/manual.html#lua_tocfunction lua_tocfunction>

{-# LINE 237 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
foreign import ccall unsafe "lua.h lua_tocfunction"

{-# LINE 241 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
  lua_tocfunction :: LuaState -> StackIndex -> IO CFunction


{-# LINE 244 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
-- | See <https://www.lua.org/manual/5.3/manual.html#lua_tointegerx lua_tointegerx>

{-# LINE 246 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
foreign import ccall unsafe "lua.h lua_tointegerx"

{-# LINE 250 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
  lua_tointegerx :: LuaState -> StackIndex -> Ptr LuaBool -> IO LuaInteger

-- | See <https://www.lua.org/manual/5.3/manual.html#lua_tonumberx lua_tonumberx>

{-# LINE 254 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
foreign import ccall unsafe "lua.h lua_tonumberx"

{-# LINE 258 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
  lua_tonumberx :: LuaState -> StackIndex -> Ptr LuaBool -> IO LuaNumber

{-# LINE 276 "src/Foreign/Lua/Api/RawBindings.hsc" #-}

-- | See <https://www.lua.org/manual/5.3/manual.html#lua_tolstring lua_tolstring>

{-# LINE 279 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
foreign import ccall unsafe "lua.h lua_tolstring"

{-# LINE 283 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
  lua_tolstring :: LuaState -> StackIndex -> Ptr CSize -> IO (Ptr CChar)

-- | See <https://www.lua.org/manual/5.3/manual.html#lua_topointer lua_topointer>

{-# LINE 287 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
foreign import ccall unsafe "lua.h lua_topointer"

{-# LINE 291 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
  lua_topointer :: LuaState -> StackIndex -> IO (Ptr ())

-- | See <https://www.lua.org/manual/5.3/manual.html#lua_tothread lua_tothread>

{-# LINE 295 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
foreign import ccall unsafe "lua.h lua_tothread"

{-# LINE 299 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
  lua_tothread :: LuaState -> StackIndex -> IO LuaState

-- | See <https://www.lua.org/manual/5.3/manual.html#lua_touserdata lua_touserdata>

{-# LINE 303 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
foreign import ccall unsafe "lua.h lua_touserdata"

{-# LINE 307 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
  lua_touserdata :: LuaState -> StackIndex -> IO (Ptr a)


--
-- Object size
--


{-# LINE 315 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
-- | See <https://www.lua.org/manual/5.3/manual.html#lua_rawlen lua_rawlen>

{-# LINE 317 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
foreign import ccall unsafe "lua.h lua_rawlen"

{-# LINE 321 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
  lua_rawlen :: LuaState -> StackIndex -> IO CSize

{-# LINE 331 "src/Foreign/Lua/Api/RawBindings.hsc" #-}


--------------------------------------------------------------------------------
-- * Push functions

-- | See <https://www.lua.org/manual/5.3/manual.html#lua_pushnil lua_pushnil>

{-# LINE 338 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
foreign import ccall unsafe "lua.h lua_pushnil"

{-# LINE 342 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
  lua_pushnil :: LuaState -> IO ()

-- | See <https://www.lua.org/manual/5.3/manual.html#lua_pushnumber lua_pushnumber>

{-# LINE 346 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
foreign import ccall unsafe "lua.h lua_pushnumber"

{-# LINE 350 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
  lua_pushnumber :: LuaState -> LuaNumber -> IO ()

-- | See <https://www.lua.org/manual/5.3/manual.html#lua_pushinteger lua_pushinteger>

{-# LINE 354 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
foreign import ccall unsafe "lua.h lua_pushinteger"

{-# LINE 358 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
  lua_pushinteger :: LuaState -> LuaInteger -> IO ()

-- | See <https://www.lua.org/manual/5.3/manual.html#lua_pushlstring lua_pushlstring>

{-# LINE 362 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
foreign import ccall unsafe "lua.h lua_pushlstring"

{-# LINE 366 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
  lua_pushlstring :: LuaState -> Ptr CChar -> CSize -> IO ()

-- lua_pushstring is currently not supported. It's difficult to use in a haskell
-- context.

-- | See <https://www.lua.org/manual/5.3/manual.html#lua_pushcclosure lua_pushcclosure>

{-# LINE 373 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
foreign import ccall unsafe "lua.h lua_pushcclosure"

{-# LINE 377 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
  lua_pushcclosure :: LuaState -> CFunction -> NumArgs -> IO ()

-- | See <https://www.lua.org/manual/5.3/manual.html#lua_pushboolean lua_pushboolean>

{-# LINE 381 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
foreign import ccall unsafe "lua.h lua_pushboolean"

{-# LINE 385 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
  lua_pushboolean :: LuaState -> LuaBool -> IO ()

-- | See <https://www.lua.org/manual/5.3/manual.html#lua_pushlightuserdata lua_pushlightuserdata>

{-# LINE 389 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
foreign import ccall unsafe "lua.h lua_pushlightuserdata"

{-# LINE 393 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
  lua_pushlightuserdata :: LuaState -> Ptr a -> IO ()

-- | See <https://www.lua.org/manual/5.3/manual.html#lua_pushthread lua_pushthread>

{-# LINE 397 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
foreign import ccall unsafe "lua.h lua_pushthread"

{-# LINE 401 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
  lua_pushthread :: LuaState -> IO CInt


--------------------------------------------------------------------------------
-- * Get functions

-- lua_gettable is unsafe, use hslua_gettable instead.
-- lua_getfield is unsafe, use hslua_getfield instead.
-- lua_getglobal is unsafe, use hslua_getglobal instead.
-- lua_getfenv (5.1 only) is not supported.

-- | Wrapper around <https://lua.org/manual/5.3/manual.html#lua_gettable \
-- @lua_gettable@> which catches any @longjmp@s.
foreign import ccall "safer-api.h hslua_gettable"
  hslua_gettable :: LuaState -> StackIndex -> IO CInt

-- | Wrapper around <https://lua.org/manual/5.3/manual.html#lua_getfield \
-- @lua_getfield@> which catches any @longjmp@s.
foreign import ccall "safer-api.h hslua_getfield"
  hslua_getfield :: LuaState -> StackIndex -> Ptr CChar -> IO CInt

-- | See <https://www.lua.org/manual/5.3/manual.html#lua_rawget lua_rawget>

{-# LINE 424 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
foreign import ccall unsafe "lua.h lua_rawget"

{-# LINE 428 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
  lua_rawget :: LuaState -> StackIndex -> IO ()

-- | See <https://www.lua.org/manual/5.3/manual.html#lua_rawgeti lua_rawgeti>

{-# LINE 432 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
foreign import ccall unsafe "lua.h lua_rawgeti"

{-# LINE 436 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
  lua_rawgeti :: LuaState -> StackIndex -> CInt -> IO ()

-- | See <https://www.lua.org/manual/5.3/manual.html#lua_createtable lua_createtable>

{-# LINE 440 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
foreign import ccall unsafe "lua.h lua_createtable"

{-# LINE 444 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
  lua_createtable :: LuaState -> CInt -> CInt -> IO ()

-- | See <https://www.lua.org/manual/5.3/manual.html#lua_newuserdata lua_newuserdata>

{-# LINE 448 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
foreign import ccall unsafe "lua.h lua_newuserdata"

{-# LINE 452 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
  lua_newuserdata :: LuaState -> CInt -> IO (Ptr ())

-- | See <https://www.lua.org/manual/5.3/manual.html#lua_getmetatable lua_getmetatable>

{-# LINE 456 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
foreign import ccall unsafe "lua.h lua_getmetatable"

{-# LINE 460 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
  lua_getmetatable :: LuaState -> StackIndex -> IO CInt

-- | Wrapper around <https://lua.org/manual/5.3/manual.html#lua_getglobal \
-- @lua_getglobal@> which catches any @longjmp@s.
foreign import ccall "safer-api.h hslua_getglobal"
  hslua_getglobal :: LuaState -> Ptr CChar -> IO CInt


--------------------------------------------------------------------------------
-- * Set functions

-- lua_settable is unsafe, use hslua_settable instead.
-- lua_setfield is unsafe, use hslua_setfield instead.
-- lua_setglobal is unsafe, use hslua_setglobal instead.
-- lua_setfenv (5.1 only) is not supported.

-- | Wrapper around <https://lua.org/manual/5.3/manual.html#lua_settable \
-- @lua_settable@> which catches any @longjmp@s.
foreign import ccall "safer-api.h hslua_settable"
  hslua_settable :: LuaState -> StackIndex -> IO CInt

-- | Wrapper around <https://lua.org/manual/5.3/manual.html#lua_setfield \
-- @lua_setfield@> which catches any @longjmp@s.
foreign import ccall "safer-api.h hslua_setfield"
  hslua_setfield :: LuaState -> StackIndex -> Ptr CChar -> IO CInt

-- | See <https://www.lua.org/manual/5.3/manual.html#lua_rawset lua_rawset>

{-# LINE 488 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
foreign import ccall unsafe "lua.h lua_rawset"

{-# LINE 492 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
  lua_rawset :: LuaState -> StackIndex -> IO ()

-- | See <https://www.lua.org/manual/5.3/manual.html#lua_rawseti lua_rawseti>

{-# LINE 496 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
foreign import ccall unsafe "lua.h lua_rawseti"

{-# LINE 500 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
  lua_rawseti :: LuaState -> StackIndex -> CInt -> IO ()

-- | See <https://www.lua.org/manual/5.3/manual.html#lua_setmetatable lua_setmetatable>

{-# LINE 504 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
foreign import ccall unsafe "lua.h lua_setmetatable"

{-# LINE 508 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
  lua_setmetatable :: LuaState -> StackIndex -> IO ()

-- | Wrapper around <https://lua.org/manual/5.3/manual.html#lua_setglobal \
-- @lua_setglobal@> which catches any @longjmp@s.
foreign import ccall "safer-api.h hslua_setglobal"
  hslua_setglobal :: LuaState -> Ptr CChar -> IO CInt


--------------------------------------------------------------------------------
-- * 'load' and 'call' functions (load and run Lua code)


{-# LINE 520 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
-- | See <https://www.lua.org/manual/5.3/manual.html#lua_pcallk lua_pcallk>
foreign import ccall "lua.h lua_pcallk"
  lua_pcallk :: LuaState -> NumArgs -> NumResults -> StackIndex
             -> CInt -> Ptr () -> IO StatusCode

{-# LINE 530 "src/Foreign/Lua/Api/RawBindings.hsc" #-}

-- currently unsupported:
-- lua_load
-- lua_dump


------------------------------------------------------------------------------
-- * Coroutine functions

-- lua_yield / lua_yieldk and lua_resume are currently not supported.

-- | See <https://www.lua.org/manual/5.3/manual.html#lua_status lua_status>
foreign import ccall unsafe "lua.h lua_status"
  lua_status :: LuaState -> IO StatusCode


------------------------------------------------------------------------------
-- * Garbage-collection functions and options

-- | See <https://www.lua.org/manual/5.3/manual.html#lua_gc lua_gc>
foreign import ccall "lua.h lua_gc"
  lua_gc :: LuaState -> CInt -> CInt -> IO CInt


------------------------------------------------------------------------------
-- * Miscellaneous functions

-- lua_error is unsafe in a haskell context and hence not supported.
-- lua_next is unsafe, use hslua_next instead.
-- lua_concat is unsafe (may trigger a longjmp), use hslua_concat instead.

-- | Wrapper around <https://lua.org/manual/5.3/manual.html#lua_next \
-- @lua_next@> which catches any @longjmp@s.
foreign import ccall "safer-api.h hslua_next"
  hslua_next :: LuaState -> StackIndex -> IO (Failable LuaBool)

-- | Wrapper around <https://lua.org/manual/5.3/manual.html#lua_concat \
-- @lua_concat@> which catches any @longjmp@s.
foreign import ccall "safer-api.h hslua_concat"
  hslua_concat :: LuaState -> NumArgs -> IO (Failable LuaBool)


------------------------------------------------------------------------------
-- * Lua Libraries

-- | See <https://www.lua.org/manual/5.3/manual.html#luaL_openlibs luaL_openlibs>
foreign import ccall unsafe "lualib.h luaL_openlibs"
  luaL_openlibs :: LuaState -> IO ()

-- | Point to function opening the base library.
foreign import ccall unsafe "lualib.h &luaopen_base"
  lua_open_base_ptr :: CFunction

-- | Point to function opening the table library.
foreign import ccall unsafe "lualib.h &luaopen_table"
  lua_open_table_ptr :: CFunction

-- | Point to function opening the io library.
foreign import ccall unsafe "lualib.h &luaopen_io"
  lua_open_io_ptr :: CFunction

-- | Point to function opening the os library.
foreign import ccall unsafe "lualib.h &luaopen_os"
  lua_open_os_ptr :: CFunction

-- | Point to function opening the string library.
foreign import ccall unsafe "lualib.h &luaopen_string"
  lua_open_string_ptr :: CFunction

-- | Point to function opening the math library.
foreign import ccall unsafe "lualib.h &luaopen_math"
  lua_open_math_ptr :: CFunction

-- | Point to function opening the debug library.
foreign import ccall unsafe "lualib.h &luaopen_debug"
  lua_open_debug_ptr :: CFunction

-- | Point to function opening the package library.
foreign import ccall unsafe "lualib.h &luaopen_package"
  lua_open_package_ptr :: CFunction


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

-- | See <https://www.lua.org/manual/5.3/manual.html#luaL_newstate luaL_newstate>
foreign import ccall unsafe "lauxlib.h luaL_newstate"
  luaL_newstate :: IO LuaState

-- | See <https://www.lua.org/manual/5.3/manual.html#luaL_newmetatable luaL_newmetatable>
foreign import ccall "lauxlib.h luaL_newmetatable"
  luaL_newmetatable :: LuaState -> Ptr CChar -> IO LuaBool

-- | See <https://www.lua.org/manual/5.3/manual.html#luaL_ref luaL_ref>
foreign import ccall "lauxlib.h luaL_ref"
  luaL_ref :: LuaState -> StackIndex -> IO CInt

-- | See <https://www.lua.org/manual/5.3/manual.html#luaL_unref luaL_unref>
foreign import ccall "lauxlib.h luaL_unref"
  luaL_unref :: LuaState -> StackIndex -> CInt -> IO ()


{-# LINE 632 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
-- | See <https://www.lua.org/manual/5.3/manual.html#luaL_loadfilex luaL_loadfilex>
foreign import ccall "lauxlib.h luaL_loadfilex"
  luaL_loadfilex :: LuaState -> Ptr CChar -> Ptr CChar -> IO StatusCode

{-# LINE 640 "src/Foreign/Lua/Api/RawBindings.hsc" #-}

-- | See <https://www.lua.org/manual/5.3/manual.html#luaL_loadstring luaL_loadstring>

{-# LINE 643 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
foreign import ccall unsafe "lauxlib.h luaL_loadstring"

{-# LINE 647 "src/Foreign/Lua/Api/RawBindings.hsc" #-}
  luaL_loadstring :: LuaState -> Ptr CChar -> IO StatusCode

--------------------------------------------------------------------------------
-- * Error transformation (Haskell to Lua)
foreign import ccall "safer-api.h &hslua_call_hs"
  hslua_call_hs_ptr :: CFunction