{-# LANGUAGE OverloadedStrings #-}
{-|
Module      : Foreign.Lua.Core.Auxiliary
Copyright   : © 2007–2012 Gracjan Polak,
                2012–2016 Ömer Sinan Ağacan,
                2017-2020 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 Foreign.C (withCString)
import Foreign.Lua.Core.Types (Lua, liftLua)
import Foreign.Lua.Raw.Auxiliary
import Foreign.Lua.Raw.Constants (multret)
import Foreign.Lua.Raw.Types (StackIndex, Status)
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

-- * The Auxiliary Library

-- | Loads and runs the given string.
--
-- Returns 'Lua.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 :: FilePath -> Lua Status
dofile FilePath
fp = do
  Status
loadRes <- FilePath -> Lua Status
loadfile FilePath
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 -> FilePath -> Lua Type
getmetafield StackIndex
obj FilePath
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 ->
  FilePath -> (CString -> IO Type) -> IO Type
forall a. FilePath -> (CString -> IO a) -> IO a
withCString FilePath
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

-- | 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' :: FilePath -> Lua Type
getmetatable' FilePath
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 ->
  FilePath -> (CString -> IO Type) -> IO Type
forall a. FilePath -> (CString -> IO a) -> IO a
withCString FilePath
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

-- | 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 -> FilePath -> Lua Bool
getsubtable StackIndex
idx FilePath
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 (FilePath -> ByteString
Utf8.fromString FilePath
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 -> FilePath -> Lua ()
Lua.setfield StackIndex
idx' FilePath
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 @'Lua.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 -> FilePath -> Lua Status
loadbuffer ByteString
bs FilePath
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) ->
  FilePath -> (CString -> IO Status) -> IO Status
forall a. FilePath -> (CString -> IO a) -> IO a
withCString FilePath
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))

-- | Loads a file as a Lua chunk. This function uses @lua_load@ (see
-- @'Lua.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 @'Lua.load'@.
--
-- This function returns the same results as @'Lua.load'@, but it has an
-- extra error code @'Lua.ErrFile'@ for file-related errors (e.g., it
-- cannot open or read the file).
--
-- As @'Lua.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 :: FilePath -> Lua Status
loadfile FilePath
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 -> FilePath -> Lua Status
loadbuffer ByteString
script (FilePath
"@" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
fp)
  Left IOException
e -> do
    ByteString -> Lua ()
Lua.pushstring (FilePath -> ByteString
Utf8.fromString (IOException -> FilePath
forall a. Show a => a -> FilePath
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 (FilePath -> IO ByteString
B.readFile FilePath
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
-- @'Lua.load'@).
--
-- Also as @'Lua.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 -> FilePath -> Lua Status
loadbuffer ByteString
s (ByteString -> FilePath
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 :: FilePath -> Lua Bool
newmetatable FilePath
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
<$> FilePath -> (CString -> IO LuaBool) -> IO LuaBool
forall a. FilePath -> (CString -> IO a) -> IO a
withCString FilePath
tname (State -> CString -> IO LuaBool
luaL_newmetatable State
l)

-- | 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 = IO State
hsluaL_newstate

-- | 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 @'Lua.refnil'@. The constant @'Lua.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

-- | 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 = do
  State
l <- Lua State
Lua.state
  ErrorConversion
e <- Lua ErrorConversion
Lua.errorConversion
  IO ByteString -> Lua ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
Lua.liftIO (IO ByteString -> Lua ByteString)
-> IO ByteString -> Lua 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 ErrorConversion -> State -> IO ByteString
ErrorConversion -> forall a. State -> IO a
Lua.errorToException ErrorConversion
e State
l
      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)

-- | 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 FilePath -> Int -> Lua ()
traceback State
l1 Maybe FilePath
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 FilePath
msg of
    Maybe FilePath
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 FilePath
msg' -> FilePath -> (CString -> IO ()) -> IO ()
forall a. FilePath -> (CString -> IO a) -> IO a
withCString FilePath
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)

-- | 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)