1{-# LANGUAGE OverloadedStrings #-}
2{-|
3Module      : Foreign.Lua.Core.Auxiliary
4Copyright   : © 2007–2012 Gracjan Polak,
5                2012–2016 Ömer Sinan Ağacan,
6                2017-2020 Albert Krewinkel
7License     : MIT
8Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de>
9Stability   : beta
10Portability : non-portable (depends on GHC)
11
12Wrappers for the auxiliary library.
13-}
14module Foreign.Lua.Core.Auxiliary
15  ( dostring
16  , dofile
17  , getmetafield
18  , getmetatable'
19  , getsubtable
20  , loadbuffer
21  , loadfile
22  , loadstring
23  , newmetatable
24  , newstate
25  , tostring'
26  , traceback
27  -- * References
28  , getref
29  , ref
30  , unref
31  -- * Registry fields
32  , loadedTableRegistryField
33  , preloadTableRegistryField
34  ) where
35
36import Control.Exception (IOException, try)
37import Data.ByteString (ByteString)
38import Foreign.C (withCString)
39import Foreign.Lua.Core.Types (Lua, liftLua)
40import Foreign.Lua.Raw.Auxiliary
41import Foreign.Lua.Raw.Constants (multret)
42import Foreign.Lua.Raw.Types (StackIndex, Status)
43import Foreign.Marshal.Alloc (alloca)
44import Foreign.Ptr
45
46import qualified Data.ByteString as B
47import qualified Foreign.Lua.Core.Functions as Lua
48import qualified Foreign.Lua.Core.Types as Lua
49import qualified Foreign.Lua.Utf8 as Utf8
50import qualified Foreign.Storable as Storable
51
52-- * The Auxiliary Library
53
54-- | Loads and runs the given string.
55--
56-- Returns 'Lua.OK' on success, or an error if either loading of the
57-- string or calling of the thunk failed.
58dostring :: ByteString -> Lua Status
59dostring s = do
60  loadRes <- loadstring s
61  if loadRes == Lua.OK
62    then Lua.pcall 0 multret Nothing
63    else return loadRes
64
65-- | Loads and runs the given file. Note that the filepath is interpreted by
66-- Haskell, not Lua. The resulting chunk is named using the UTF8 encoded
67-- filepath.
68dofile :: FilePath -> Lua Status
69dofile fp = do
70  loadRes <- loadfile fp
71  if loadRes == Lua.OK
72    then Lua.pcall 0 multret Nothing
73    else return loadRes
74
75-- | Pushes onto the stack the field @e@ from the metatable of the object at
76-- index @obj@ and returns the type of the pushed value. If the object does not
77-- have a metatable, or if the metatable does not have this field, pushes
78-- nothing and returns TypeNil.
79getmetafield :: StackIndex -- ^ obj
80             -> String     -- ^ e
81             -> Lua Lua.Type
82getmetafield obj e = liftLua $ \l ->
83  withCString e $ fmap Lua.toType . luaL_getmetafield l obj
84
85-- | Pushes onto the stack the metatable associated with name @tname@ in the
86-- registry (see @newmetatable@) (@nil@ if there is no metatable associated
87-- with that name). Returns the type of the pushed value.
88getmetatable' :: String -- ^ tname
89              -> Lua Lua.Type
90getmetatable' tname = liftLua $ \l ->
91  withCString tname $ fmap Lua.toType . luaL_getmetatable l
92
93-- | Push referenced value from the table at the given index.
94getref :: StackIndex -> Reference -> Lua ()
95getref idx ref' = Lua.rawgeti idx (fromIntegral (Lua.fromReference ref'))
96
97-- | Ensures that the value @t[fname]@, where @t@ is the value at index @idx@,
98-- is a table, and pushes that table onto the stack. Returns True if it finds a
99-- previous table there and False if it creates a new table.
100getsubtable :: StackIndex -> String -> Lua Bool
101getsubtable idx fname = do
102  -- This is a reimplementation of luaL_getsubtable from lauxlib.c.
103  idx' <- Lua.absindex idx
104  Lua.pushstring (Utf8.fromString fname)
105  Lua.gettable idx'
106  isTbl <- Lua.istable Lua.stackTop
107  if isTbl
108    then return True
109    else do
110      Lua.pop 1
111      Lua.newtable
112      Lua.pushvalue Lua.stackTop -- copy to be left at top
113      Lua.setfield idx' fname
114      return False
115
116-- | Loads a ByteString as a Lua chunk.
117--
118-- This function returns the same results as @'Lua.load'@. @name@ is the
119-- chunk name, used for debug information and error messages. Note that
120-- @name@ is used as a C string, so it may not contain null-bytes.
121--
122-- See <https://www.lua.org/manual/5.3/manual.html#luaL_loadbuffer luaL_loadbuffer>.
123loadbuffer :: ByteString -- ^ Program to load
124           -> String     -- ^ chunk name
125           -> Lua Status
126loadbuffer bs name = liftLua $ \l ->
127  B.useAsCStringLen bs $ \(str, len) ->
128  withCString name
129    (fmap Lua.toStatus . luaL_loadbuffer l str (fromIntegral len))
130
131-- | Loads a file as a Lua chunk. This function uses @lua_load@ (see
132-- @'Lua.load'@) to load the chunk in the file named filename. The first
133-- line in the file is ignored if it starts with a @#@.
134--
135-- The string mode works as in function @'Lua.load'@.
136--
137-- This function returns the same results as @'Lua.load'@, but it has an
138-- extra error code @'Lua.ErrFile'@ for file-related errors (e.g., it
139-- cannot open or read the file).
140--
141-- As @'Lua.load'@, this function only loads the chunk; it does not run
142-- it.
143--
144-- Note that the file is opened by Haskell, not Lua.
145--
146-- See <https://www.lua.org/manual/5.3/manual.html#luaL_loadfile luaL_loadfile>.
147loadfile :: FilePath -- ^ filename
148         -> Lua Status
149loadfile fp = Lua.liftIO contentOrError >>= \case
150  Right script -> loadbuffer script ("@" <> fp)
151  Left e -> do
152    Lua.pushstring (Utf8.fromString (show e))
153    return Lua.ErrFile
154 where
155  contentOrError :: IO (Either IOException ByteString)
156  contentOrError = try (B.readFile fp)
157
158
159-- | Loads a string as a Lua chunk. This function uses @lua_load@ to
160-- load the chunk in the given ByteString. The given string may not
161-- contain any NUL characters.
162--
163-- This function returns the same results as @lua_load@ (see
164-- @'Lua.load'@).
165--
166-- Also as @'Lua.load'@, this function only loads the chunk; it does not
167-- run it.
168--
169-- See <https://www.lua.org/manual/5.3/manual.html#luaL_loadstring luaL_loadstring>.
170loadstring :: ByteString -> Lua Status
171loadstring s = loadbuffer s (Utf8.toString s)
172
173
174-- | If the registry already has the key tname, returns @False@. Otherwise,
175-- creates a new table to be used as a metatable for userdata, adds to this new
176-- table the pair @__name = tname@, adds to the registry the pair @[tname] = new
177-- table@, and returns @True@. (The entry @__name@ is used by some
178-- error-reporting functions.)
179--
180-- In both cases pushes onto the stack the final value associated with @tname@ in
181-- the registry.
182--
183-- The value of @tname@ is used as a C string and hence must not contain null
184-- bytes.
185--
186-- See also:
187-- <https://www.lua.org/manual/5.3/manual.html#luaL_newmetatable luaL_newmetatable>.
188newmetatable :: String -> Lua Bool
189newmetatable tname = liftLua $ \l ->
190  Lua.fromLuaBool <$> withCString tname (luaL_newmetatable l)
191
192-- | Creates a new Lua state. It calls @lua_newstate@ with an allocator
193-- based on the standard C @realloc@ function and then sets a panic
194-- function (see <https://www.lua.org/manual/5.3/manual.html#4.6 §4.6>
195-- of the Lua 5.3 Reference Manual) that prints an error message to the
196-- standard error output in case of fatal errors.
197--
198-- See also:
199-- <https://www.lua.org/manual/5.3/manual.html#luaL_newstate luaL_newstate>.
200newstate :: IO Lua.State
201newstate = hsluaL_newstate
202
203-- | Creates and returns a reference, in the table at index @t@, for the object
204-- at the top of the stack (and pops the object).
205--
206-- A reference is a unique integer key. As long as you do not manually add
207-- integer keys into table @t@, @ref@ ensures the uniqueness of the key it
208-- returns. You can retrieve an object referred by reference @r@ by calling
209-- @rawgeti t r@. Function @'unref'@ frees a reference and its associated
210-- object.
211--
212-- If the object at the top of the stack is nil, @'ref'@ returns the
213-- constant @'Lua.refnil'@. The constant @'Lua.noref'@ is guaranteed to
214-- be different from any reference returned by @'ref'@.
215--
216-- See also: <https://www.lua.org/manual/5.3/manual.html#luaL_ref luaL_ref>.
217ref :: StackIndex -> Lua Reference
218ref t = liftLua $ \l -> Lua.toReference <$> luaL_ref l t
219
220-- | Converts any Lua value at the given index to a @'ByteString'@ in a
221-- reasonable format. The resulting string is pushed onto the stack and also
222-- returned by the function.
223--
224-- If the value has a metatable with a @__tostring@ field, then @tolstring'@
225-- calls the corresponding metamethod with the value as argument, and uses the
226-- result of the call as its result.
227tostring' :: StackIndex -> Lua B.ByteString
228tostring' n = do
229  l <- Lua.state
230  e <- Lua.errorConversion
231  Lua.liftIO $ alloca $ \lenPtr -> do
232    cstr <- hsluaL_tolstring l n lenPtr
233    if cstr == nullPtr
234      then Lua.errorToException e l
235      else do
236        cstrLen <- Storable.peek lenPtr
237        B.packCStringLen (cstr, fromIntegral cstrLen)
238
239-- | Creates and pushes a traceback of the stack L1. If a message is given it
240-- appended at the beginning of the traceback. The level parameter tells at
241-- which level to start the traceback.
242traceback :: Lua.State -> Maybe String -> Int -> Lua ()
243traceback l1 msg level = liftLua $ \l ->
244  case msg of
245    Nothing -> luaL_traceback l l1 nullPtr (fromIntegral level)
246    Just msg' -> withCString msg' $ \cstr ->
247      luaL_traceback l l1 cstr (fromIntegral level)
248
249-- | Releases reference @'ref'@ from the table at index @idx@ (see @'ref'@). The
250-- entry is removed from the table, so that the referred object can be
251-- collected. The reference @'ref'@ is also freed to be used again.
252--
253-- See also:
254-- <https://www.lua.org/manual/5.3/manual.html#luaL_unref luaL_unref>.
255unref :: StackIndex -- ^ idx
256      -> Reference  -- ^ ref
257      -> Lua ()
258unref idx r = liftLua $ \l ->
259  luaL_unref l idx (Lua.fromReference r)
260