diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,4 +1,23 @@ ## Changelog + +### 0.9.3 + +- Re-export more FunctionCalling helpers in `Foreign.Lua`: The typeclass + `ToHaskellFunction` and the helper function `toHaskellFunction` are + useful when working with functions. Importing them separately from + `Foreign.Lua.FunctionCalling` was an unnecessary burden; they are + therefor now re-exported by the main module. +- Export registry-relatd constants `refnil` and `noref`: The constants + are related to Lua's registry functions (`ref` and `unref`). +- Add helper to convert functions into CFunction: A new helper + `wrapHaskellFunction` is provided. It expects a + HaskellImportedFunction userdata (as produced by + `pushHaskellFunction`) on top of the stack and replaces it with a C + function. The new function converts error values generated with + `lerror` into Lua errors, i.e. it calls `lua_error`. +- Add utility function `setglobal'`: It works like `setglobal`, but + works with packages and nested tables (dot-notation only). + ### 0.9.2 - Add cabal flag 'export-dynamic': Default behavior is to include all symbols in diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -14,6 +14,99 @@ [Hackage]: http://img.shields.io/hackage/v/hslua.svg +Overview +-------- + +[Lua](https://lua.org) is a small, well-designed, embeddable scripting language. +It has become the de-facto default to make programs extensible and is widely +used everywhere from servers over games and desktop applications up to security +software and embedded devices. This package provides Haskell bindings to Lua, +enable coders to embed the language into their programs, making them scriptable. + +HsLua ships with batteries included and includes the most recent Lua version. +However, cabal flags make it easy to swap this out in favor of a Lua version +already installed on the host system. It supports the versions 5.1, 5.2, 5.3, +and LuaJIT. + + +Interacting with Lua +-------------------- + +HsLua provides the `Lua` type to define Lua operations. The operations are +executed by calling `runLua`. A simple "Hello, World" program, using the Lua +`print` function, is given below: + +``` haskell +import Foreign.Lua + +main :: IO () +main = runLua prog + where + prog :: Lua () + prog = do + openlibs -- load lua libraries so we can use 'print' + callFunc "print" "Hello, World!" +``` + +### The Lua stack + +Lua's API is stack-centered: most operations involve pushing values to the stack +or receiving items from the stack. E.g., calling a function is performed by +pushing the function onto the stack, followed by the function arguments in the +order they should be passed to the function. The API function `call` then +invokes the function with given numbers of arguments, pops the function and +parameters of the stack, and pushes the results. + + ,----------. + | arg 3 | + +----------+ + | arg 2 | + +----------+ + | arg 1 | + +----------+ ,----------. + | function | call 3 1 | result 1 | + +----------+ ===========> +----------+ + | | | | + | stack | | stack | + | | | | + +Manually pushing and pulling arguments can become tiresome, so HsLua makes +function calling simple by providing `callFunc`. It uses type-magic to allow +different numbers of arguments. Think about it as having the signature + + callFunc :: String -> a1 -> a2 -> … -> res + +where the arguments `a1, a2, …` must be of a type which can be pushed to the Lua +stack, and the result-type `res` must be constructable from a value on the Lua +stack. + +### Getting values from and to the Lua stack + +Conversion between Haskell and Lua values is governed by two type classes: + +``` haskell +-- | A value that can be read from the Lua stack. +class FromLuaStack a where + -- | Check if at index @n@ there is a convertible Lua value and + -- if so return it. Throws a @'LuaException'@ otherwise. + peek :: StackIndex -> Lua a +``` + +and + +``` haskell +-- | A value that can be pushed to the Lua stack. +class ToLuaStack a where + -- | Pushes a value onto Lua stack, casting it into meaningfully + -- nearest Lua type. + push :: a -> Lua () +``` + +Many basic data types (except for numeric types, see the FAQ) have instances for +these type classes. New instances can be defined for custom types using the +functions in `Foreign.Lua.Api` (also exported in `Foreign.Lua`). + + Build flags ----------- @@ -60,6 +153,14 @@ FAQ --- + +**Is anybody using this?** Absolutely. E.g., [Pandoc](https://pandoc.org), the +universal document converter, is written in Haskell and includes a Lua +interpreter, enabling programmatic modifications of documents via Lua. +Furthermore, custom output formats can be defined via Lua scripts. This has been +used in [pandoc-scholar](https://github.com/pandoc-scholar/pandoc-scholar) +([paper](https://peerj.com/articles/cs-112/)) to allow for semantically enriched +scholarly articles. **Where are the coroutine related functions?** Yielding from a coroutine works via `longjmp`, which plays very badly with Haskell's RTS. Tests to get diff --git a/hslua.cabal b/hslua.cabal --- a/hslua.cabal +++ b/hslua.cabal @@ -1,5 +1,5 @@ name: hslua -version: 0.9.2 +version: 0.9.3 stability: beta cabal-version: >= 1.8 license: MIT @@ -27,9 +27,7 @@ README.md CHANGELOG.md COPYRIGHT - test/lua/syntax-error.lua - test/lua/error.lua - test/lua/example.lua + test/lua/*.lua source-repository head type: git diff --git a/safer-api/safer-api.c b/safer-api/safer-api.c --- a/safer-api/safer-api.c +++ b/safer-api/safer-api.c @@ -1,6 +1,44 @@ +#include #include #include "safer-api.h" +/* ********************************************************************* + * Transforming Haskell errors to Lua errors + * *********************************************************************/ +void hslua_pushhaskellerr(lua_State *L) +{ + lua_getglobal(L, "_HASKELLERR"); +} + +/* Error handling */ +int hslua_call_hs(lua_State *L) +{ + int nargs = lua_gettop(L); + /* Push HaskellImportFunction and call the underlying function */ + lua_pushvalue(L, lua_upvalueindex(1)); + lua_insert(L, 1); + lua_call(L, nargs, LUA_MULTRET); + + /* Check whether an error value was returned */ + int nres = lua_gettop(L); + /* We signal an error on the haskell side by passing two values: the special + * haskellerr object and the error message. + */ + if (nres == 2) { + hslua_pushhaskellerr(L); + int is_err = lua_rawequal(L, 0 + 1, -1); + lua_pop(L, 1); /* pop haskellerr used for equality test */ + if (is_err) { + lua_remove(L, 1); /* remove returned haskellerr */ + return lua_error(L); + } + } + return nres; +} + +/* ********************************************************************* + * Transforming Lua errors to Haskell errors + * *********************************************************************/ /* compare */ #if LUA_VERSION_NUM >= 502 int hslua__compare(lua_State *L) diff --git a/safer-api/safer-api.h b/safer-api/safer-api.h --- a/safer-api/safer-api.h +++ b/safer-api/safer-api.h @@ -1,5 +1,7 @@ #include "lua.h" +int hslua_call_hs(lua_State *L); + #if LUA_VERSION_NUM >= 502 int hslua_compare(lua_State *L, int index1, int index2, int op); #endif diff --git a/src/Foreign/Lua.hs b/src/Foreign/Lua.hs --- a/src/Foreign/Lua.hs +++ b/src/Foreign/Lua.hs @@ -50,6 +50,8 @@ -- * Calling Functions , PreCFunction , HaskellFunction + , ToHaskellFunction (..) + , toHaskellFunction , callFunc , newCFunction , freeCFunction @@ -59,6 +61,7 @@ , runLua , runLuaEither , getglobal' + , setglobal' -- * API , module Foreign.Lua.Api , module Foreign.Lua.Api.Types diff --git a/src/Foreign/Lua/Api.hs b/src/Foreign/Lua/Api.hs --- a/src/Foreign/Lua/Api.hs +++ b/src/Foreign/Lua/Api.hs @@ -51,6 +51,8 @@ -- ** Constants and pseudo-indices , multret , registryindex + , noref + , refnil , upvalueindex -- ** State manipulation , LuaState (..) @@ -169,6 +171,7 @@ -- * Helper functions , throwTopMessageAsError , throwTopMessageAsError' + , wrapHaskellFunction ) where import Prelude hiding (EQ, LT, compare, concat) @@ -237,6 +240,16 @@ BC.unpack <$> tostring (-1) else pop 1 *> showPointer +-- | Convert a Haskell function userdata object into a CFuntion. The userdata +-- object must be at the top of the stack. Errors signaled via lerror are +-- converted to lua errors. +wrapHaskellFunction :: Lua () +wrapHaskellFunction = do + t <- ltype (-1) + case t of + TypeUserdata -> pushcclosure hslua_call_hs_ptr 1 + _ -> throwLuaError "Need HaskellImportedFunction to create a CFunction." + -- -- API functions -- @@ -951,7 +964,20 @@ rawseti :: StackIndex -> Int -> Lua () rawseti k m = liftLua $ \l -> lua_rawseti l k (fromIntegral m) --- | See . +-- | 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: . ref :: StackIndex -> Lua Int ref t = liftLua $ \l -> fromIntegral <$> luaL_ref l t diff --git a/src/Foreign/Lua/Api/Constants.hsc b/src/Foreign/Lua/Api/Constants.hsc --- a/src/Foreign/Lua/Api/Constants.hsc +++ b/src/Foreign/Lua/Api/Constants.hsc @@ -38,6 +38,8 @@ module Foreign.Lua.Api.Constants ( multret , registryindex + , refnil + , noref #if LUA_VERSION_NUMBER < 502 , environindex , globalsindex @@ -47,6 +49,7 @@ import Foreign.Lua.Api.Types #include "lua.h" +#include "lauxlib.h" -- | Alias for C constant @LUA_MULTRET@. See -- . @@ -57,6 +60,14 @@ -- . registryindex :: StackIndex registryindex = StackIndex $ #{const LUA_REGISTRYINDEX} + +-- | Value signaling that no reference was created. +refnil :: Int +refnil = #{const LUA_REFNIL} + +-- | Value signaling that no reference was found. +noref :: Int +noref = #{const LUA_NOREF} #if LUA_VERSION_NUMBER < 502 -- | Alias for C constant @LUA_ENVIRONINDEX@. See diff --git a/src/Foreign/Lua/Api/RawBindings.hsc b/src/Foreign/Lua/Api/RawBindings.hsc --- a/src/Foreign/Lua/Api/RawBindings.hsc +++ b/src/Foreign/Lua/Api/RawBindings.hsc @@ -41,7 +41,6 @@ import Foreign.Lua.Api.Types import Foreign.Ptr -#include "lua.h" #include "safer-api.h" -- TODO: lua_getallocf, lua_setallocf @@ -640,3 +639,8 @@ foreign import ccall safe "lauxlib.h luaL_loadstring" #endif 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 diff --git a/src/Foreign/Lua/FunctionCalling.hs b/src/Foreign/Lua/FunctionCalling.hs --- a/src/Foreign/Lua/FunctionCalling.hs +++ b/src/Foreign/Lua/FunctionCalling.hs @@ -144,7 +144,7 @@ callFunc :: (LuaCallFunc a) => String -> a callFunc f = callFunc' f (return ()) 0 --- | Pushes Haskell function converted to a Lua function. +-- | Pushes Haskell function as a callable userdata. -- All values created will be garbage collected. Use as: -- -- > pushHaskellFunction myfun diff --git a/src/Foreign/Lua/Util.hs b/src/Foreign/Lua/Util.hs --- a/src/Foreign/Lua/Util.hs +++ b/src/Foreign/Lua/Util.hs @@ -33,6 +33,7 @@ -} module Foreign.Lua.Util ( getglobal' + , setglobal' , runLua , runLuaEither ) where @@ -54,16 +55,42 @@ runLuaEither :: Lua a -> IO (Either LuaException a) runLuaEither = try . runLua --- | Like @getglobal@, but knows about packages. e. g. +-- | Like @getglobal@, but knows about packages and nested tables. E.g. -- --- > getglobal' l "math.sin" +-- > getglobal' "math.sin" -- --- returns correct result +-- will return the function @sin@ in package @math@. getglobal' :: String -> Lua () -getglobal' n = do - let (x : xs) = splitdot n - getglobal x - mapM_ dotable xs - where - splitdot = filter (/= ".") . groupBy (\a b -> a /= '.' && b /= '.') - dotable a = getfield (-1) a *> remove (-2) +getglobal' = getnested . splitdot + +-- | 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. +setglobal' :: String -> Lua () +setglobal' s = + case reverse (splitdot s) of + [] -> + return () + [_] -> + setglobal s + (lastField : xs) -> do + getnested (reverse xs) + pushvalue (-2) + setfield (-2) lastField + pop 1 + +-- | Gives the list of the longest substrings not containing dots. +splitdot :: String -> [String] +splitdot = filter (/= ".") . groupBy (\a b -> a /= '.' && b /= '.') + +-- | Pushes the value described by the strings to the stack; where the first +-- value is the name of a global variable and the following strings are the +-- field values in nested tables. +getnested :: [String] -> Lua () +getnested [] = return () +getnested (x:xs) = do + getglobal x + mapM_ (\a -> getfield (-1) a *> remove (-2)) xs diff --git a/test/Foreign/Lua/FunctionCallingTest.hs b/test/Foreign/Lua/FunctionCallingTest.hs --- a/test/Foreign/Lua/FunctionCallingTest.hs +++ b/test/Foreign/Lua/FunctionCallingTest.hs @@ -24,8 +24,9 @@ import Data.ByteString.Char8 (pack, unpack) import Foreign.Lua.Api -import Foreign.Lua.FunctionCalling (callFunc, peek, registerHaskellFunction) -import Foreign.Lua.Types (Lua, catchLuaError) +import Foreign.Lua.FunctionCalling (callFunc, peek, registerHaskellFunction, + pushHaskellFunction) +import Foreign.Lua.Types (Lua, catchLuaError, throwLuaError) import Foreign.Lua.Util (runLua) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (assertEqual, testCase) @@ -74,6 +75,30 @@ errMsg = "Error during function call: could not read " ++ "argument 2: Expected a number but got a boolean" in assertEqual "Unexpected result" errMsg =<< runLua (catchLuaError luaOp (return . show)) + + , testCase "convert haskell function to c function" $ + let luaOp :: Lua LuaInteger + luaOp = do + pushHaskellFunction integerOperation + wrapHaskellFunction + pushinteger 71 + pushinteger 107 + call 2 1 + peek (-1) <* pop 1 + in assertEqual "Unexpected result" 100 =<< runLua luaOp + + , testCase "Error in Haskell function is converted into Lua error" $ + let luaOp :: Lua (Bool, String) + luaOp = do + openlibs + pushHaskellFunction (throwLuaError "foo" :: Lua ()) + wrapHaskellFunction + setglobal "throw_foo" + loadstring "return pcall(throw_foo)" *> call 0 2 + (,) <$> peek (-2) <*> peek (-1) + + errMsg = "Error during function call: foo" + in assertEqual "Unexpected result" (False, errMsg) =<< runLua luaOp ] , testGroup "call lua function from haskell" diff --git a/test/Foreign/LuaTest.hs b/test/Foreign/LuaTest.hs --- a/test/Foreign/LuaTest.hs +++ b/test/Foreign/LuaTest.hs @@ -83,6 +83,16 @@ pushLuaExpr "'Moin'" equal (-1) (-2) + , luaTestCase "setting a nested global works" $ do + let v = "Mitte" + newtable + setglobal "berlin" + + pushstring v + setglobal' "berlin.neighborhood" + v' <- getglobal' "berlin.neighborhood" *> tostring (-1) + return (v == v') + , testCase "table reading" . runLua $ do openbase