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) |
Safe Haskell | None |
Language | Haskell2010 |
Bindings, functions, and utilities enabling the integration of a Lua interpreter into a haskell project.
Basic access to the Lua API is provided by '@Foreign.Lua.Core@'.
Synopsis
- module Foreign.Lua.Core
- class Peekable a where
- peek :: StackIndex -> Lua a
- peekEither :: Peekable a => StackIndex -> Lua (Either String a)
- peekList :: Peekable a => StackIndex -> Lua [a]
- peekKeyValuePairs :: (Peekable a, Peekable b) => StackIndex -> Lua [(a, b)]
- peekRead :: Read a => StackIndex -> Lua a
- peekAny :: Data a => StackIndex -> Lua a
- class Pushable a where
- pushList :: Pushable a => [a] -> Lua ()
- pushAny :: Data a => a -> Lua ()
- type PreCFunction = State -> IO NumResults
- type HaskellFunction = Lua NumResults
- class ToHaskellFunction a where
- toHsFun :: StackIndex -> a -> Lua NumResults
- toHaskellFunction :: ToHaskellFunction a => a -> HaskellFunction
- callFunc :: LuaCallFunc a => String -> a
- newCFunction :: ToHaskellFunction a => a -> Lua CFunction
- freeCFunction :: CFunction -> Lua ()
- pushHaskellFunction :: ToHaskellFunction a => a -> Lua ()
- registerHaskellFunction :: ToHaskellFunction a => String -> a -> Lua ()
- run :: Lua a -> IO a
- runEither :: Lua a -> IO (Either Exception a)
- getglobal' :: String -> Lua ()
- setglobal' :: String -> Lua ()
- raiseError :: Pushable a => a -> Lua NumResults
- newtype Optional a = Optional {
- fromOptional :: Maybe a
- popValue :: Peekable a => Lua a
- requirehs :: String -> Lua () -> Lua ()
- preloadhs :: String -> Lua NumResults -> Lua ()
- create :: Lua ()
- addfield :: Pushable a => String -> a -> Lua ()
- addfunction :: ToHaskellFunction a => String -> a -> Lua ()
Core
module Foreign.Lua.Core
Receiving values from Lua stack (Lua → Haskell)
class Peekable a where Source #
A value that can be read from the Lua stack.
peek :: StackIndex -> Lua a Source #
Check if at index n
there is a convertible Lua value and if so return
it. Throws a
otherwise.Exception
Instances
peekEither :: Peekable a => StackIndex -> Lua (Either String a) Source #
Try to convert the value at the given stack index to a Haskell value.
Returns Left
with an error message on failure.
peekKeyValuePairs :: (Peekable a, Peekable b) => StackIndex -> Lua [(a, b)] Source #
Read a table into a list of pairs.
peekRead :: Read a => StackIndex -> Lua a Source #
Get a value by retrieving a String from Lua, then using
to
convert the String into a Haskell value.readMaybe
peekAny :: Data a => StackIndex -> Lua a Source #
Retrieve Haskell data which was pushed to Lua as userdata.
Pushing values to Lua stack (Haskell → Lua)
class Pushable a where Source #
A value that can be pushed to the Lua stack.
Pushes a value onto Lua stack, casting it into meaningfully nearest Lua type.
Instances
Calling Functions
type PreCFunction = State -> IO NumResults Source #
Type of raw Haskell functions that can be made into CFunction
s.
type HaskellFunction = Lua NumResults Source #
Haskell function that can be called from Lua.
class ToHaskellFunction a where Source #
Operations and functions that can be pushed to the Lua stack. This is a
helper function not intended to be used directly. Use the
wrapper instead.toHaskellFunction
toHsFun :: StackIndex -> a -> Lua NumResults Source #
Helper function, called by toHaskellFunction
Instances
ToHaskellFunction HaskellFunction Source # | |
Defined in Foreign.Lua.FunctionCalling toHsFun :: StackIndex -> HaskellFunction -> Lua NumResults Source # | |
Pushable a => ToHaskellFunction (Lua a) Source # | |
Defined in Foreign.Lua.FunctionCalling toHsFun :: StackIndex -> Lua a -> Lua NumResults Source # | |
(Peekable a, ToHaskellFunction b) => ToHaskellFunction (a -> b) Source # | |
Defined in Foreign.Lua.FunctionCalling toHsFun :: StackIndex -> (a -> b) -> Lua NumResults Source # |
toHaskellFunction :: ToHaskellFunction a => a -> HaskellFunction Source #
Convert a Haskell function to Lua function. Any Haskell function can be converted provided that:
Any
will be converted to a string and returned
as Lua error.Exception
Important: this does not catch exceptions other than
; exception handling must be done by the converted
Haskell function. Failure to do so will cause the program to crash.Exception
E.g., the following code could be used to handle an Exception of type
FooException, if that type is an instance of
and
MonadCatch
:Pushable
toHaskellFunction (myFun `catchM` (\e -> raiseError (e :: FooException)))
callFunc :: LuaCallFunc a => String -> a Source #
Call a Lua function. Use as:
v <- callfunc "proc" "abc" (1::Int) (5.0::Double)
newCFunction :: ToHaskellFunction a => a -> Lua CFunction Source #
Create new foreign Lua function. Function created can be called
by Lua engine. Remeber to free the pointer with freecfunction
.
freeCFunction :: CFunction -> Lua () Source #
Free function pointer created with newcfunction
.
pushHaskellFunction :: ToHaskellFunction a => a -> Lua () Source #
registerHaskellFunction :: ToHaskellFunction a => String -> a -> Lua () Source #
Imports a Haskell function and registers it at global name.
Utility functions and types
Run Lua computation using the default HsLua state as starting point. Exceptions are masked, thus avoiding some issues when using multiple threads. All exceptions are passed through; error handling is the responsibility of the caller.
runEither :: Lua a -> IO (Either Exception a) Source #
Run the given Lua computation; exceptions raised in haskell code are caught, but other exceptions (user exceptions raised in haskell, unchecked type errors, etc.) are passed through.
getglobal' :: String -> Lua () Source #
Like getglobal
, but knows about packages and nested tables. E.g.
getglobal' "math.sin"
will return the function sin
in package math
.
setglobal' :: String -> Lua () Source #
Like setglobal
, but knows about packages and nested tables. E.g.
pushstring "0.9.4" setglobal' "mypackage.version"
All tables and fields, except for the last field, must exist.
raiseError :: Pushable a => a -> Lua NumResults Source #
Raise a Lua error, using the given value as the error object.
Newtype wrapper intended to be used for optional Lua values. Nesting this type is strongly discouraged as missing values on inner levels are indistinguishable from missing values on an outer level; wrong values would be the likely result.
Optional | |
|
Retrieving values
popValue :: Peekable a => Lua a Source #
Get, then pop the value at the top of the stack. The pop operation is executed even if the retrieval operation failed.
Modules
requirehs :: String -> Lua () -> Lua () Source #
Load a module, defined by a Haskell action, under the given name.
Similar to luaL_required
: After checking "loaded" table, calls
pushMod
to push a module to the stack, and registers the result in
package.loaded
table.
The pushMod
function must push exactly one element to the top of
the stack. This is not checked, but failure to do so will lead to
problems. Lua's package
module must have been loaded by the time
this function is invoked.
Leaves a copy of the module on the stack.
preloadhs :: String -> Lua NumResults -> Lua () Source #
Registers a preloading function. Takes an module name and the Lua operation which produces the package.
addfield :: Pushable a => String -> a -> Lua () Source #
Add a string-indexed field to the table at the top of the stack.
addfunction :: ToHaskellFunction a => String -> a -> Lua () Source #
Attach a function to the table at the top of the stack, using the given name.