├── .gitignore ├── stack.yaml ├── CHANGELOG.md ├── examples ├── wishlist │ ├── filter.lua │ └── wishlist.hs ├── callbacks │ ├── output │ ├── callbacks.lua │ └── callbacks.hs ├── err_prop │ ├── err_prop.lua │ ├── output │ └── err_prop.hs ├── lualib_in_haskell │ ├── main.lua │ ├── LibArith.hs │ ├── Makefile │ └── libarithhelper.c ├── haskellfun │ ├── output │ ├── haskellfun.lua │ └── haskellfun.hs └── lua-version │ └── lua-version.hs ├── README.md ├── COPYRIGHT ├── .github └── workflows │ └── ci.yml └── hslua-examples.cabal /.gitignore: -------------------------------------------------------------------------------- 1 | /dist 2 | /.stack-work 3 | /stack.yaml.lock 4 | # Helper files generated by GHC 5 | *_stub.h -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | flags: {} 2 | packages: 3 | - '.' 4 | extra-deps: 5 | - hslua-1.3.0 6 | resolver: lts-16.24 7 | 8 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | ## Changelog 2 | 3 | ### 0.1.0 4 | 5 | * Use examples previously included in the hslua 0.5.0 library. 6 | -------------------------------------------------------------------------------- /examples/wishlist/filter.lua: -------------------------------------------------------------------------------- 1 | return function (wish) 2 | return wish.child.nice and 3 | wish.toy == 'TrainSet' 4 | end 5 | -------------------------------------------------------------------------------- /examples/callbacks/output: -------------------------------------------------------------------------------- 1 | begin 2 | callback 1 3 | callback 2 4 | reset callbacks 5 | add callbacks in reverse order 6 | callback 3 7 | callback 2 8 | callback 1 9 | Failing from Lua -------------------------------------------------------------------------------- /examples/err_prop/err_prop.lua: -------------------------------------------------------------------------------- 1 | function fail_when_zero(n) 2 | print("Lua: " .. tostring(n)) 3 | if n == 0 then 4 | error("Failing from Lua") 5 | end 6 | return fail_when_zero_haskell(n - 1) 7 | end 8 | -------------------------------------------------------------------------------- /examples/lualib_in_haskell/main.lua: -------------------------------------------------------------------------------- 1 | require "lualibhelper" 2 | 3 | hs_init() 4 | print("add_in_haskell(1,2)", add_in_haskell(1, 2)) 5 | print("add_in_haskell(-10, 20)", add_in_haskell(-10, 20)) 6 | hs_exit() 7 | -------------------------------------------------------------------------------- /examples/haskellfun/output: -------------------------------------------------------------------------------- 1 | hello world! 2 | 335.54432 3 | Hello, World! 4 | Error caught from Haskell land: Error during function call: could not read argument 1: expected number, got 'wrong' (string) 5 | 6 | Error caught from Haskell land: Error during function call: could not read argument 2: expected number, got 'nil' (no value) -------------------------------------------------------------------------------- /examples/lua-version/lua-version.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Main where 4 | 5 | import Control.Monad 6 | import qualified Foreign.Lua as Lua 7 | 8 | main :: IO () 9 | main = Lua.run $ do 10 | Lua.openlibs 11 | Lua.getglobal "print" 12 | Lua.pushstring "Hello from" 13 | Lua.getglobal "_VERSION" 14 | Lua.call 2 0 15 | -------------------------------------------------------------------------------- /examples/lualib_in_haskell/LibArith.hs: -------------------------------------------------------------------------------- 1 | module LibArith where 2 | 3 | import Foreign.C.Types (CInt (CInt)) 4 | import Foreign.Lua as Lua 5 | 6 | foreign export ccall 7 | add :: Lua.State -> IO NumResults 8 | 9 | add :: Lua.State -> IO NumResults 10 | add l = runWith l $ do 11 | i1 <- peek 1 12 | i2 <- peek 2 13 | push (i1 + i2 :: Lua.Number) 14 | return 1 15 | -------------------------------------------------------------------------------- /examples/haskellfun/haskellfun.lua: -------------------------------------------------------------------------------- 1 | function catch_haskell(f, ...) 2 | local ok, ret 3 | ok, ret = pcall(f, ...) 4 | if not ok then 5 | print("Error caught from Haskell land: " .. ret) 6 | return 7 | end 8 | return ret 9 | end 10 | 11 | print(concat("hello", " world!")) 12 | print(catch_haskell(pow, 3.2, 5)) 13 | print(catch_haskell(helloWorld)) 14 | print(catch_haskell(pow, "wrong")) 15 | print(catch_haskell(pow, 3)) 16 | -------------------------------------------------------------------------------- /examples/err_prop/output: -------------------------------------------------------------------------------- 1 | Lua: 10 2 | Haskell: Integer 9 3 | Lua: 8 4 | Haskell: Integer 7 5 | Lua: 6 6 | Haskell: Integer 5 7 | Lua: 4 8 | Haskell: Integer 3 9 | Lua: 2 10 | Haskell: Integer 1 11 | Lua: 0 12 | ret: ErrRun 13 | errMsg: examples/err_prop/err_prop.lua:4: Failing from Lua 14 | top: StackIndex {fromStackIndex = 1} 15 | Haskell: Integer 10 16 | Lua: 9 17 | Haskell: Integer 8 18 | Lua: 7 19 | Haskell: Integer 6 20 | Lua: 5 21 | Haskell: Integer 4 22 | Lua: 3 23 | Haskell: Integer 2 24 | Lua: 1 25 | Haskell: Integer 0 26 | err_prop: Lua exception: Failing from Haskell -------------------------------------------------------------------------------- /examples/lualib_in_haskell/Makefile: -------------------------------------------------------------------------------- 1 | LUA_LIBDIR = /usr/include/lua5.3 2 | 3 | run: export LD_LIBRARY_PATH := . 4 | run: libarith.so lualibhelper.so 5 | lua main.lua 6 | 7 | # Assumes GHC 8.8.4, as used in stackage lts-16.24 8 | libarith.so: LibArith.hs 9 | stack ghc -- $^ -o $@ -shared -fPIC -dynamic -lHSrts-ghc8.8.4 10 | 11 | lualibhelper.so: libarith.so libarithhelper.c 12 | stack ghc -- libarithhelper.c \ 13 | -no-hs-main -o $@ \ 14 | -shared -fPIC -dynamic \ 15 | -L. -larith -I$(LUA_LIBDIR) 16 | 17 | clean: 18 | rm -f *.hi 19 | rm -f *.o 20 | rm -f *.so 21 | rm -f *_stub.h 22 | -------------------------------------------------------------------------------- /examples/lualib_in_haskell/libarithhelper.c: -------------------------------------------------------------------------------- 1 | #include "LibArith_stub.h" 2 | #include "lua.h" 3 | 4 | int hs_init_lua(lua_State *L) 5 | { 6 | hs_init(NULL, NULL); 7 | return 0; 8 | } 9 | 10 | int hs_exit_lua(lua_State *L) 11 | { 12 | hs_exit(); 13 | return 0; 14 | } 15 | 16 | int luaopen_lualibhelper(lua_State *L) 17 | { 18 | lua_pushcfunction(L, (int (*)(lua_State*))add); 19 | lua_setglobal(L, "add_in_haskell"); 20 | lua_pushcfunction(L, hs_init_lua); 21 | lua_setglobal(L, "hs_init"); 22 | lua_pushcfunction(L, hs_exit_lua); 23 | lua_setglobal(L, "hs_exit"); 24 | return 0; 25 | } 26 | -------------------------------------------------------------------------------- /examples/callbacks/callbacks.lua: -------------------------------------------------------------------------------- 1 | local function c1() 2 | print("callback 1") 3 | return "callback 1 return value" 4 | end 5 | 6 | local function c2() 7 | print("callback 2") 8 | return false 9 | end 10 | 11 | local function c3() 12 | print("callback 3") 13 | return 3 14 | end 15 | 16 | local function c_fails() 17 | print("Failing from Lua") 18 | error("failed") 19 | end 20 | 21 | print("begin") 22 | addLuaCallbacks(c1, c2) 23 | callLuaCallbacks() 24 | print("reset callbacks") 25 | resetLuaCallbacks() 26 | callLuaCallbacks() 27 | print("add callbacks in reverse order") 28 | addLuaCallbacks(c3) 29 | addLuaCallbacks(c2) 30 | addLuaCallbacks(c1) 31 | addLuaCallbacks(c_fails) 32 | local callbackrets = callLuaCallbacks() 33 | for _, v in ipairs(callbackrets) do 34 | print(v) 35 | end 36 | print("end") 37 | -------------------------------------------------------------------------------- /examples/haskellfun/haskellfun.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | -- An example with higher-level Haskell functions. Haskell functions are 4 | -- wrapped by hslua automatically for ensuring argument types and nubmers 5 | -- and passing arguments from Lua stack to Haskell functions. Return values 6 | -- are also handled by hslua automatically(so you don't put return value to 7 | -- stack manually). 8 | 9 | import qualified Data.ByteString as B 10 | import Data.Monoid 11 | import Foreign.Lua as Lua 12 | 13 | main :: IO () 14 | main = Lua.run $ do 15 | openlibs 16 | registerHaskellFunction "concat" concat' 17 | registerHaskellFunction "pow" pow 18 | registerHaskellFunction "helloWorld" helloWorld 19 | loadfile "examples/haskellfun/haskellfun.lua" 20 | call 0 0 21 | 22 | concat' :: B.ByteString -> B.ByteString -> Lua B.ByteString 23 | concat' s1 s2 = return $ s1 <> s2 24 | 25 | pow :: Lua.Number -> Lua.Number -> Lua Lua.Number 26 | pow d1 d2 = return $ d1 ** d2 27 | 28 | helloWorld :: Lua B.ByteString 29 | helloWorld = return "Hello, World!" 30 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | HsLua examples 2 | ============== 3 | 4 | **This repository has been archived. See the `hslua-examples` folder in the 5 | main hslua repo for up-to-date examples.** 6 | 7 | The following examples are available: 8 | 9 | - **lua-version**: A simple program which uses Lua library functions and 10 | Lua variables to print the Lua version against which the program was 11 | linked. 12 | 13 | - **haskellfun**: Demo how functions written in Haskell can be exposed 14 | to Lua. Includes a short Lua script which makes use of these 15 | functions. 16 | 17 | - **callbacks**: Program that demonstrates how Haskell callbacks can be 18 | passed to Lua, and how Lua callbacks can be collected and called from 19 | Haskell. 20 | 21 | - **err_prop**: Demonstrates how errors propagate in HsLua programs. 22 | This consists of two parts: the Haskell program, and a short Lua 23 | script. 24 | 25 | - **lualib_in_haskell**: Lua can make use of dynamically loaded 26 | libraries. This shows how such a library can be created with HsLua, 27 | exposing functions written in Haskell to Lua. 28 | -------------------------------------------------------------------------------- /COPYRIGHT: -------------------------------------------------------------------------------- 1 | Copyright (C) 2007-2012 Gracjan Polak 2 | Copyright (C) 2012-2015 Ömer Sinan Ağacan 3 | Copyright (C) 2017 Albert Krewinkel 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in 13 | all copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 21 | THE SOFTWARE. 22 | -------------------------------------------------------------------------------- /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | name: CI 2 | 3 | # Trigger the workflow on push or pull request, but only for the 4 | # master branch 5 | on: 6 | pull_request: 7 | push: 8 | 9 | jobs: 10 | examples: 11 | name: Run examples 12 | runs-on: ubuntu-18.04 13 | steps: 14 | - name: Checkout 15 | uses: actions/checkout@v2 16 | 17 | - name: Install Lua shared library 18 | run: | 19 | sudo apt install lua5.3 liblua5.3-0 liblua5.3-dev 20 | sudo ln -s /usr/bin/lua5.3 /usr/bin/lua 21 | 22 | - name: Setup stack 23 | run: | 24 | stack update 25 | stack setup 26 | 27 | - name: Build 28 | run: | 29 | stack build \ 30 | --flag hslua:hardcode-reg-keys \ 31 | --flag hslua:pkg-config \ 32 | --flag hslua:system-lua 33 | 34 | - name: Run example "lua-version" 35 | run: | 36 | stack exec lua-version 37 | 38 | - name: Run example "callbacks" 39 | run: | 40 | stack exec callbacks 41 | 42 | - name: Run example "haskellfun" 43 | run: | 44 | stack exec haskellfun 45 | 46 | - name: Run example "err_prop" 47 | run: | 48 | stack exec err_prop 49 | 50 | - name: Run example "wishlist" 51 | run: | 52 | stack exec wishlist -- examples/wishlist/filter.lua 53 | 54 | - name: Test dynamical Haskell library 55 | run: make -C examples/lualib_in_haskell clean run 56 | -------------------------------------------------------------------------------- /examples/wishlist/wishlist.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | import Control.Monad (filterM) 3 | import Data.Text (Text, pack) 4 | import Foreign.Lua ( Lua, NumResults (..), NumArgs (..), call, dofile 5 | , newtable, nthFromTop, pop, pushvalue, run, setfield 6 | , stackTop, toboolean) 7 | import Foreign.Lua.Push (pushBool, pushText) 8 | import System.Environment (getArgs) 9 | 10 | data Toy = Bricks | TrainSet | Doll deriving Show 11 | data Behavior = Nice | Naughty deriving (Eq, Show) 12 | 13 | data Wish = Wish 14 | { wishingChild :: Child 15 | , wishedToy :: Toy 16 | } deriving Show 17 | 18 | data Child = Child 19 | { childName :: Text 20 | , childBehavior :: Behavior 21 | } deriving Show 22 | 23 | pushToy :: Toy -> Lua () 24 | pushToy = pushText . pack . show 25 | 26 | pushChild :: Child -> Lua () 27 | pushChild (Child name behavior) = do 28 | -- create new Lua table on the stack 29 | newtable 30 | -- push boolean to stack 31 | pushText name 32 | -- table now in position 2; assign string to field in table 33 | setfield (nthFromTop 2) "name" 34 | 35 | -- push boolean to stack 36 | pushBool (behavior == Nice) 37 | setfield (nthFromTop 2) "nice" 38 | 39 | pushWish :: Wish -> Lua () 40 | pushWish (Wish child toy) = do 41 | newtable 42 | pushChild child 43 | setfield (nthFromTop 2) "child" 44 | pushToy toy 45 | setfield (nthFromTop 2) "toy" 46 | 47 | wishes :: [Wish] 48 | wishes = 49 | [ Wish (Child "Theodor" Nice) Bricks 50 | , Wish (Child "Philine" Nice) TrainSet 51 | , Wish (Child "Steve" Naughty) Doll 52 | ] 53 | 54 | hasPredicate :: Wish -> Lua Bool 55 | hasPredicate wish = do 56 | -- Assume filter function is at the top of the stack; 57 | -- create a copy so we can re-use it. 58 | pushvalue stackTop 59 | pushWish wish 60 | -- Call the function. There is one argument on the stack, 61 | -- and we expect one result to be returned. 62 | call (NumArgs 1) (NumResults 1) 63 | toboolean stackTop <* pop 1 64 | 65 | main :: IO () 66 | main = do 67 | filterFile <- fmap (!! 0) getArgs -- get first argument 68 | result <- run $ do 69 | _status <- dofile filterFile 70 | filterM hasPredicate wishes 71 | print result 72 | -------------------------------------------------------------------------------- /hslua-examples.cabal: -------------------------------------------------------------------------------- 1 | name: hslua-examples 2 | version: 1.0.0 3 | stability: beta 4 | cabal-version: >= 1.8 5 | license: MIT 6 | build-type: Simple 7 | license-File: COPYRIGHT 8 | copyright: © 2007–2012 Gracjan Polak 9 | © 2012–2016 Ömer Sinan Ağacan 10 | © 2016–2018 Albert Krewinkel 11 | author: Gracjan Polak, Ömer Sinan Ağacan 12 | maintainer: Albert Krewinkel 13 | synopsis: Examples of using haskell and lua together. 14 | description: The Foreign.Lua module is a wrapper of Lua language interpreter 15 | as described in [lua.org](http://www.lua.org/). 16 | . 17 | This package contains example programs, demonstrating 18 | the possibility to work with lua from within haskell and 19 | vice versa. 20 | category: Foreign 21 | extra-source-files: README.md 22 | CHANGELOG.md 23 | COPYRIGHT 24 | examples/callbacks/callbacks.lua 25 | examples/haskellfun/haskellfun.lua 26 | examples/err_prop/err_prop.lua 27 | 28 | source-repository head 29 | type: git 30 | location: https://github.com/tarleb/hslua-examples.git 31 | 32 | executable lua-version 33 | main-is: lua-version.hs 34 | hs-source-dirs: examples/lua-version 35 | build-depends: base 36 | , hslua >= 1.0 && < 1.4 37 | 38 | executable wishlist 39 | main-is: wishlist.hs 40 | hs-source-dirs: examples/wishlist 41 | build-depends: base, bytestring, text 42 | , hslua >= 1.0 && < 1.4 43 | 44 | executable callbacks 45 | main-is: callbacks.hs 46 | hs-source-dirs: examples/callbacks 47 | build-depends: base 48 | , bytestring 49 | , hslua >= 1.0 && < 1.4 50 | 51 | executable haskellfun 52 | main-is: haskellfun.hs 53 | hs-source-dirs: examples/haskellfun 54 | build-depends: base, bytestring 55 | , hslua >= 1.0 && < 1.4 56 | 57 | executable err_prop 58 | main-is: err_prop.hs 59 | hs-source-dirs: examples/err_prop 60 | build-depends: base, bytestring 61 | , hslua >= 1.0 && < 1.4 62 | -------------------------------------------------------------------------------- /examples/err_prop/err_prop.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | -- An example program that demonstrates error propagation between Haskell and 4 | -- Lua. It creates a function call stack with 10 functions, like this: 5 | -- 6 | -- Lua function 7 | -- ... 8 | -- Haskell function 9 | -- Lua function 10 | -- Program 11 | -- 12 | -- And then the function at the top throws an error, according to the error 13 | -- conventions described in the docs. The error is propagated to the program at 14 | -- the bottom. 15 | -- 16 | -- Then the same thing happens, starting with Haskell function: 17 | -- 18 | -- Haskell function 19 | -- ... 20 | -- Lua function 21 | -- Haskell function 22 | -- Program 23 | 24 | import qualified Data.ByteString.Char8 as BC 25 | import Foreign.C.Types (CInt) 26 | import Foreign.Lua as Lua 27 | 28 | main :: IO () 29 | main = run $ do 30 | openlibs 31 | registerHaskellFunction "fail_when_zero_haskell" failWhenZero 32 | 33 | -- Define the Lua function 34 | loadfile "examples/err_prop/err_prop.lua" 35 | call 0 0 36 | 37 | -- Start the loop by calling Lua function with argument 10 38 | getglobal "fail_when_zero" 39 | pushinteger 10 40 | -- Since Lua function will be the one that propagates error to the program, 41 | -- we need to catch it using `pcall` 42 | ret <- pcall 1 1 Nothing 43 | errMsg <- peek 1 44 | liftIO $ putStrLn $ "ret: " ++ show ret 45 | liftIO $ putStrLn $ "errMsg: " ++ errMsg 46 | 47 | top <- gettop 48 | liftIO $ putStrLn $ "top: " ++ show top 49 | pop 1 50 | 51 | -- start the loop by calling Haskell function with argument 10 52 | getglobal "fail_when_zero_haskell" 53 | pushinteger 10 54 | -- Our convention is that Haskell functions never use `lua_error` because 55 | -- it's never safe(it's not even exported by the library for this reason). 56 | -- So if we're calling a Haskell function that `pcall` and `call` does the 57 | -- same thing. 58 | _ <- pcall 1 2 Nothing 59 | -- We know it failed, so just read the error message without checking 60 | -- first argument 61 | errMsg <- peek 1 62 | liftIO $ putStrLn $ "errMsg: " ++ errMsg 63 | pop 2 64 | 65 | failWhenZero :: Lua NumResults 66 | failWhenZero = do 67 | i <- peek 1 :: Lua Lua.Integer 68 | liftIO $ putStrLn $ "Haskell: " ++ show i 69 | if i == 0 70 | then pushstring "Failing from Haskell" *> Lua.error 71 | else do 72 | getglobal "fail_when_zero" 73 | pushinteger (i - 1) 74 | ret <- pcall 1 1 Nothing 75 | if ret /= OK 76 | then 77 | -- propagate the error. no need to push error message since it's 78 | -- already at the top of the stack at this point. (because of how 79 | -- `pcall` works) 80 | Lua.error 81 | else 82 | -- Lua function's return value is on the stack, return it 83 | return 1 84 | -------------------------------------------------------------------------------- /examples/callbacks/callbacks.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | -- An example hslua program that demonstrates providing Haskell callbacks 4 | -- to Lua and getting Lua callbacks from Haskell. 5 | 6 | import qualified Data.ByteString.Char8 as BC 7 | import Control.Monad (void) 8 | import Data.IORef 9 | import Foreign.Lua 10 | 11 | main :: IO () 12 | main = do 13 | callbacks <- newIORef [] 14 | run $ do 15 | openlibs 16 | registerHaskellFunction "addLuaCallbacks" (addLuaCallbacks callbacks) 17 | registerHaskellFunction "callLuaCallbacks" (callLuaCallbacks callbacks) 18 | registerHaskellFunction "resetLuaCallbacks" (resetLuaCallbacks callbacks) 19 | void $ dofile "examples/callbacks/callbacks.lua" 20 | 21 | type LuaFunRef = Reference 22 | 23 | -- | Get Lua callbacks as argument to later call them in order. 24 | -- Successive calls to this function without calling `resetLuaCallbacks` 25 | -- adds more callbacks to the queue. 26 | -- (I know lists are not the best functional queue implementations ...) 27 | addLuaCallbacks :: IORef [LuaFunRef] -> Lua NumResults 28 | addLuaCallbacks cs = do 29 | -- number of arguments passed to this function 30 | args <- gettop 31 | -- make sure arguments are functions 32 | as <- checkArgs args 33 | case as of 34 | Nothing -> do 35 | -- arguments are functions, add them to callback queue and return 36 | -- nothing 37 | addCallbacks 1 args 38 | return 0 39 | Just errArg -> do 40 | -- error: argument at `errArg` is not a function, return error 41 | -- string 42 | pushstring $ BC.pack $ 43 | "argument " ++ show errArg ++ " is not a function" 44 | return 1 45 | where 46 | -- | Check if all arguments are functions, return `Just argIdx` if 47 | -- argument at `argIdx` is not a function and `Nothing` otherwise. 48 | checkArgs :: StackIndex -> Lua (Maybe StackIndex) 49 | checkArgs 0 = return Nothing 50 | checkArgs n = do 51 | ty <- ltype n 52 | if ty == TypeFunction 53 | then checkArgs (n-1) 54 | else return $ Just n 55 | 56 | addCallbacks :: StackIndex -> StackIndex -> Lua () 57 | addCallbacks n maxIdx 58 | | n > maxIdx = return () 59 | | otherwise = do 60 | -- move nth argument to top of the stack 61 | pushvalue n 62 | -- add function reference to registry 63 | refId <- ref registryindex 64 | -- add registry index to IORef 65 | liftIO $ modifyIORef cs (++ [refId]) 66 | -- continue adding other arguments 67 | addCallbacks (n+1) maxIdx 68 | 69 | -- | Call Lua callbacks collected with `addLuaCallbacks`. 70 | callLuaCallbacks :: IORef [LuaFunRef] -> Lua NumResults 71 | callLuaCallbacks cs = do 72 | cs' <- liftIO $ readIORef cs 73 | -- push new array to the stack 74 | createtable (length cs') 0 75 | -- call callbacks and fill array with return values 76 | iter cs' 77 | return 1 78 | where 79 | iter [] = return () 80 | iter (c : rest) = do 81 | getglobal' "table.insert" 82 | pushvalue (-2) 83 | getref registryindex c 84 | -- call the callback 85 | call 0 1 86 | -- call table.insert 87 | call 2 0 88 | iter rest 89 | 90 | -- | Reset callback queue and remove Lua functions from registry to enable 91 | -- garbage collection. 92 | resetLuaCallbacks :: IORef [LuaFunRef] -> Lua NumResults 93 | resetLuaCallbacks cs = do 94 | cs' <- liftIO (readIORef cs) 95 | mapM_ (unref registryindex) cs' 96 | liftIO $ writeIORef cs [] 97 | return 0 98 | --------------------------------------------------------------------------------