hslua 1.1.2 → 1.2.0

raw patch · 39 files changed

+2731/−1669 lines, 39 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +52/−2
• cbits/error-conversion/error-conversion.c +0/−261
• cbits/error-conversion/error-conversion.h +0/−26
• cbits/hslua/hslcall.c +102/−0
• cbits/hslua/hslcall.h +12/−0
• cbits/hslua/hslua-export.h +8/−0
• cbits/hslua/hslua.c +205/−0
• cbits/hslua/hslua.h +33/−0
• cbits/hslua/hsludata.c +41/−0
• cbits/hslua/hsludata.h +11/−0
• hslua.cabal +40/−9
• src/Foreign/Lua/Call.hs +301/−0
• src/Foreign/Lua/Core.hs +2/−0
• src/Foreign/Lua/Core/Auxiliary.hs +259/−0
• src/Foreign/Lua/Core/Auxiliary.hsc +0/−335
• src/Foreign/Lua/Core/Constants.hs +22/−0
• src/Foreign/Lua/Core/Constants.hsc +0/−41
• src/Foreign/Lua/Core/Error.hs +28/−76
• src/Foreign/Lua/Core/Functions.hs +11/−13
• src/Foreign/Lua/Core/RawBindings.hs +21/−0
• src/Foreign/Lua/Core/RawBindings.hsc +0/−389
• src/Foreign/Lua/Core/Types.hs +178/−0
• src/Foreign/Lua/Core/Types.hsc +0/−422
• src/Foreign/Lua/FunctionCalling.hsc +11/−39
• src/Foreign/Lua/Module.hs +117/−15
• src/Foreign/Lua/Peek.hs +18/−0
• src/Foreign/Lua/Raw/Auxiliary.hs +135/−0
• src/Foreign/Lua/Raw/Call.hs +65/−0
• src/Foreign/Lua/Raw/Constants.hs +39/−0
• src/Foreign/Lua/Raw/Error.hs +40/−0
• src/Foreign/Lua/Raw/Functions.hs +393/−0
• src/Foreign/Lua/Raw/Types.hsc +281/−0
• src/Foreign/Lua/Raw/Userdata.hs +65/−0
• src/Foreign/Lua/Userdata.hs +14/−39
• test/Foreign/Lua/CallTests.hs +142/−0
• test/Foreign/Lua/ModuleTests.hs +71/−1
• test/Foreign/Lua/PeekTests.hs +11/−0
• test/Foreign/Lua/PushTests.hs +1/−1
• test/test-hslua.hs +2/−0

@@ -1,11 +1,61 @@ ## Changelog +### 1.2.0++Released 2020-08-15++- New module `Foreign.Lua.Call`: the module offers an alternative+  method of exposing Haskell functions to Lua. The focus is on+  maintainability: types and marshaling methods are made explicit;+  the possibility of adding documentation and parameter names+  improves error messages and allows for automatic documentation+  extraction.++  Work on this module is ongoing; the interface is likely to+  change. Suggestions and feedback are welcome.++- New types `Module`, `Field`, and new functions `registerModule`,+  `preloadModule`, `pushModule`, and `render` exported from+  `Foreign.Lua.Module`: this builds on the new `Call` module and+  allows the creation of documented modules as well as automatic+  generation of Markdown-formatted module documentation.++- Export new items `nth` and `top` from Foreign.Lua.Core and+  Foreign.Lua. They are short-hands for `nthFromTop` and+  `stackTop`.++- Performance improvements: Calling of Lua functions and creation+  of Haskell data wrapping userdata has been sped up by about 10%.+  This is mostly due to using of previously missed optimization+  opportunities.++- All foreign imports have been moved to into the new+  `Foreign.Lua.Raw` module. This module will replace the current+  `Foreign.Lua.Core` module in the future and will be distributed+  as a separate package (likely starting with the 2.0 release);+  the remaining parts of the current `Core` module will be+  promoted one level in the module hierarchy.++  The `Raw` module can be used whenever the full power of HsLua is+  not needed.++- Error-signaling of API wrapper functions has been changed:+  instead of returning special integer values, functions now take+  an additional pointer argument, which is set to the status+  result of the computation.++  The `Failable` type in Core.Error is no longer needed and has+  been removed.++- CI builds now include GHC 8.8 and GHC 8.10, ensuring that all+  GHC 8.* versions are supported.+ ### 1.1.2 -Released 2020-06-02+Released 2020-06-27  - Revert signature of function `pushList` to it's proper 1.1-  value. This fixes a mistake which made caused the 1.1.1 release+  value. This fixes a mistake which caused the 1.1.1 release   to be in violation of the PVP versioning policy.  - Module Foreign.Lua.Peek: add function `pushKeyValuePairs` (Alex

@@ -1,261 +0,0 @@-#include <stdio.h>-#include <string.h>-#include <HsFFI.h>-#include "error-conversion.h"--/* *********************************************************************- * Transforming Haskell errors to Lua errors- * *********************************************************************/-void hslua_pushhaskellerr(lua_State *L)-{-  lua_getfield(L, LUA_REGISTRYINDEX, "HSLUA_ERR");-}--/*-** Marks the occurence of an error; the returned value should be used as-** the error message.-*/-int hslua_error(lua_State *L)-{-  hslua_pushhaskellerr(L);-  lua_insert(L, -2);-  return 2;-}--/*-** Checks whether the object at the given index is a Haskell error.-*/-int hslua_is_haskell_error(lua_State *L, int idx) {-  hslua_pushhaskellerr(L);-  int is_err = lua_rawequal(L, idx, -1);-  lua_pop(L, 1);                /* pop haskellerr used for equality test */-  return is_err;-}--/*-** Converts a Haskell function into a CFunction.-**-** We signal an error on the haskell side by passing two values: the-** special haskellerr object and the error message. The function-** returned an error iff there are exactly two results objects where the-** first object is the special HSLUA_ERR registry entry.-*/-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);--  /* If there are two results, the first of which is the special error-   * object, then the other object is thrown as an error.-   */-  if (nres == 2 && hslua_is_haskell_error(L, 1)) {-    return lua_error(L);        /* throw 2nd return value as error */-  }--  return nres;-}--/* *********************************************************************- * Garbage Collection- * *********************************************************************/--/*-** Free stable Haskell pointer in userdata.-*/-int hslua_userdata_gc(lua_State *L)-{-  HsStablePtr *userdata = lua_touserdata(L, 1);-  if (userdata) {-    hs_free_stable_ptr(*userdata);-  }-  return 0;-}---/* *********************************************************************- * Transforming Lua errors to Haskell errors- * *********************************************************************/--/*-** compare-*/-int hslua__compare(lua_State *L)-{-  int op = lua_tointeger(L, 3);-  int res = lua_compare(L, 1, 2, op);-  lua_pushinteger(L, res);-  return 1;-}--int hslua_compare(lua_State *L, int index1, int index2, int op)-{-  index1 = lua_absindex(L, index1);-  index2 = lua_absindex(L, index2);-  lua_pushcfunction(L, hslua__compare);-  lua_pushvalue(L, index1);-  lua_pushvalue(L, index2);-  lua_pushinteger(L, op);-  int callres = lua_pcall(L, 3, 1, 0);-  if (callres != 0) {-    return -callres;-  }-  int res = lua_tointeger(L, -1);-  lua_pop(L, 1);-  return res;-}---/*-** concat-*/-int hslua__concat(lua_State *L)-{-  lua_concat(L, lua_gettop(L));-  return 1;-}--int hslua_concat(lua_State *L, int n)-{-  lua_pushcfunction(L, hslua__concat);-  lua_insert(L, -n - 1);-  return -lua_pcall(L, n, 1, 0);-}---/*-** getglobal-*/-int hslua__getglobal(lua_State *L)-{-  lua_gettable(L, 1);-  return 1;-}--int hslua_getglobal(lua_State *L, const char *name, size_t len)-{-  lua_pushcfunction(L, hslua__getglobal);-  lua_pushglobaltable(L);-  lua_pushlstring(L, name, len);-  return -lua_pcall(L, 2, 1, 0);-}---/*-** gettable-*/-int hslua__gettable(lua_State *L)-{-  lua_pushvalue(L, 1);-  lua_gettable(L, 2);-  return 1;-}--int hslua_gettable(lua_State *L, int index)-{-  lua_pushvalue(L, index);-  lua_pushcfunction(L, hslua__gettable);-  lua_insert(L, -3);-  return -lua_pcall(L, 2, 1, 0);-}---/*-** setglobal-*/-int hslua__setglobal(lua_State *L)-{-  /* index 1: value */-  /* index 2: the global table */-  /* index 3: key */-  lua_pushvalue(L, 1);-  lua_settable(L, 2);-  return 0;-}--int hslua_setglobal(lua_State *L, const char *name, size_t len)-{-  /* we expect the new value to be at the top of the stack */-  lua_pushglobaltable(L);-  lua_pushlstring(L, name, len);-  lua_pushcfunction(L, hslua__setglobal);-  lua_insert(L, -4);-  return -lua_pcall(L, 3, 0, 0);-}---/*-** settable-*/-int hslua__settable(lua_State *L)-{-  lua_pushvalue(L, 1); /* key */-  lua_pushvalue(L, 2); /* value */-  lua_settable(L, 3);  /* table is the third argument */-  return 0;-}--int hslua_settable(lua_State *L, int index)-{-  lua_pushvalue(L, index);-  lua_pushcfunction(L, hslua__settable);-  lua_insert(L, -4);-  return -lua_pcall(L, 3, 0, 0);-}---/*-** next-*/-int hslua__next(lua_State *L)-{-  lua_pushvalue(L, 1);-  return lua_next(L, 2) ? 2 : 0;-}--int hslua_next(lua_State *L, int index)-{-  int oldsize = lua_gettop(L);-  lua_pushvalue(L, index);-  lua_pushcfunction(L, hslua__next);-  lua_insert(L, -3);-  int res = lua_pcall(L, 2, LUA_MULTRET, 0);-  if (res != 0) {-    /* error */-    return (- res);-  }-  /* success */-  return (lua_gettop(L) - oldsize + 1); /* correct for popped value */-}---/*-** Auxiliary Library-*/--/*-** tolstring'-*/-int hsluaL__tolstring(lua_State *L)-{-  luaL_tolstring(L, 1, NULL);-  return 1;-}--const char *hsluaL_tolstring(lua_State *L, int index, size_t *len)-{-  lua_pushvalue(L, index);-  lua_pushcfunction(L, hsluaL__tolstring);-  lua_insert(L, -2);-  int res = lua_pcall(L, 1, 1, 0);-  if (res != 0) {-    /* error */-    return NULL;-  }-  return lua_tolstring(L, -1, len);-}

@@ -1,26 +0,0 @@-#include "lua.h"-#include "lauxlib.h"--int hslua_error(lua_State *L);--int hslua_call_hs(lua_State *L);--int hslua_userdata_gc(lua_State *L);--int hslua_compare(lua_State *L, int index1, int index2, int op);--int hslua_concat(lua_State *L, int n);--int hslua_getglobal(lua_State *L, const char *name, size_t len);--int hslua_gettable(lua_State *L, int index);--int hslua_setglobal(lua_State *L, const char *k, size_t len);--int hslua_settable(lua_State *L, int index);--int hslua_next(lua_State *L, int index);---/* auxiliary library */-const char *hsluaL_tolstring(lua_State *L, int index, size_t *len);

@@ -0,0 +1,102 @@+#include <HsFFI.h>+#include <lua.h>+#include <lauxlib.h>+#include "hslua-export.h"+#include "hslcall.h"+#include "hsludata.h"++/* ***************************************************************+ * Transforming Haskell errors to Lua errors+ * ***************************************************************/+void hslua_pushhaskellerr(lua_State *L)+{+  lua_getfield(L, LUA_REGISTRYINDEX, HSLUA_ERR);+}++/*+** Marks the occurence of an error; the returned value should be+** used as the error message.+*/+int hslua_error(lua_State *L)+{+  hslua_pushhaskellerr(L);+  lua_insert(L, -2);+  return 2;+}++/*+** Checks whether the object at the given index is a Haskell error.+*/+int hslua_is_haskell_error(lua_State *L, int idx)+{+  int erridx = lua_absindex(L, idx);+  hslua_pushhaskellerr(L);+  int is_err = lua_rawequal(L, erridx, -1);+  lua_pop(L, 1);        /* pop haskellerr used for equality test */+  return is_err;+}++/*+** Converts a Haskell function into a CFunction.+**+** We signal an error on the haskell side by passing two values:+** the special HSLUA_ERR object and the error message. The+** function returned an error iff there are exactly two results+** objects where the first object is the special HSLUA_ERR+** registry entry.+*/+int hslua_call_hs(lua_State *L)+{+  int nargs = lua_gettop(L);+  /* Push HaskellFunction 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);++  /* If there are two results, the first of which is the special+   * error object, then the other object is thrown as an error.+   */+  if (nres == 2 && hslua_is_haskell_error(L, 1)) {+    return lua_error(L);      /* throw 2nd return value as error */+  }++  return nres;+}++/*+** Retrieves a HsStablePtr to a Haskell function from a+** function-wrapping userdata when it's been called and removes+** the userdata from the stack.+*/+void *hslua_hs_fun_ptr(lua_State *L)+{+  void *fn = luaL_testudata(L, 1, HSLUA_HSFUN_NAME);+  lua_remove(L, 1);+  return fn;+}++/*+** Pushes a metatable for Haskell function wrapping userdata to+** the stack.+*/+void hslua_registerhsfunmetatable(lua_State *L)+{+  hslua_newudmetatable(L, HSLUA_HSFUN_NAME);+  lua_pushcfunction(L, &hslua_call_wrapped_hs_fun);+  lua_setfield(L, -2, "__call");+  lua_pop(L, 1);+}++/*+** Creates a new C function from a Haskell function.+*/+void hslua_newhsfunction(lua_State *L, HsStablePtr fn)+{+  HsStablePtr *ud = lua_newuserdata(L, sizeof fn);+  *ud = fn;+  luaL_setmetatable(L, HSLUA_HSFUN_NAME);+  lua_pushcclosure(L, &hslua_call_hs, 1);+}

@@ -0,0 +1,12 @@+#ifndef hslcall_h+#define hslcall_h++#define HSLUA_ERR "HSLUA_ERR"+#define HSLUA_HSFUN_NAME "HsLuaFunction"+#include <lua.h>+#include <HsFFI.h>++/*  register metatable for HaskellFunction userdata wrappers */+void hslua_registerhsfunmetatable(lua_State *L);++#endif

@@ -0,0 +1,8 @@+/* ***************************************************************+ * Functions exported from Haskell+ * ***************************************************************/++#include <lua.h>++/*  exported from Foreign.Lua.Raw.Call */+int hslua_call_wrapped_hs_fun(lua_State *L);

@@ -0,0 +1,205 @@+#include <stdio.h>+#include <string.h>+#include <HsFFI.h>+#include "hslua.h"+#include "hslcall.h"++/* ***************************************************************+ * Transforming Lua errors to Haskell errors+ * ***************************************************************/++/*+** compare+*/+int hslua__compare(lua_State *L)+{+  int op = lua_tointeger(L, 3);+  int res = lua_compare(L, 1, 2, op);+  lua_pushinteger(L, res);+  return 1;+}++int hslua_compare(lua_State *L, int index1, int index2, int op, int *status)+{+  index1 = lua_absindex(L, index1);+  index2 = lua_absindex(L, index2);+  lua_pushcfunction(L, hslua__compare);+  lua_pushvalue(L, index1);+  lua_pushvalue(L, index2);+  lua_pushinteger(L, op);+  *status = lua_pcall(L, 3, 1, 0);+  if (*status != LUA_OK) {+    return 0;+  }+  int result = lua_tointeger(L, -1);+  lua_pop(L, 1);+  return result;+}+++/*+** concat+*/+int hslua__concat(lua_State *L)+{+  lua_concat(L, lua_gettop(L));+  return 1;+}++void hslua_concat(lua_State *L, int n, int *status)+{+  lua_pushcfunction(L, hslua__concat);+  lua_insert(L, -n - 1);+  *status = lua_pcall(L, n, 1, 0);+}+++/*+** getglobal+*/+int hslua__getglobal(lua_State *L)+{+  lua_gettable(L, 1);+  return 1;+}++void hslua_getglobal(lua_State *L, const char *name, size_t len, int *status)+{+  lua_pushcfunction(L, hslua__getglobal);+  lua_pushglobaltable(L);+  lua_pushlstring(L, name, len);+  *status = lua_pcall(L, 2, 1, 0);+}+++/*+** gettable+*/+int hslua__gettable(lua_State *L)+{+  lua_pushvalue(L, 1);+  lua_gettable(L, 2);+  return 1;+}++void hslua_gettable(lua_State *L, int index, int *status)+{+  lua_pushvalue(L, index);+  lua_pushcfunction(L, hslua__gettable);+  lua_insert(L, -3);+  *status = lua_pcall(L, 2, 1, 0);+}+++/*+** setglobal+*/+int hslua__setglobal(lua_State *L)+{+  /* index 1: value */+  /* index 2: the global table */+  /* index 3: key */+  lua_pushvalue(L, 1);+  lua_settable(L, 2);+  return 0;+}++void hslua_setglobal(lua_State *L, const char *name, size_t len, int *status)+{+  /* we expect the new value to be at the top of the stack */+  lua_pushglobaltable(L);+  lua_pushlstring(L, name, len);+  lua_pushcfunction(L, hslua__setglobal);+  lua_insert(L, -4);+  *status = lua_pcall(L, 3, 0, 0);+}+++/*+** settable+*/+int hslua__settable(lua_State *L)+{+  lua_pushvalue(L, 1); /* key */+  lua_pushvalue(L, 2); /* value */+  lua_settable(L, 3);  /* table is the third argument */+  return 0;+}++void hslua_settable(lua_State *L, int index, int *status)+{+  lua_pushvalue(L, index);+  lua_pushcfunction(L, hslua__settable);+  lua_insert(L, -4);+  *status = lua_pcall(L, 3, 0, 0);+}+++/*+** next+*/+int hslua__next(lua_State *L)+{+  lua_pushvalue(L, 1);+  return lua_next(L, 2) ? 2 : 0;+}++int hslua_next(lua_State *L, int index, int *status)+{+  int oldsize = lua_gettop(L);+  lua_pushvalue(L, index);+  lua_pushcfunction(L, hslua__next);+  lua_insert(L, -3);+  *status = lua_pcall(L, 2, LUA_MULTRET, 0);+  if (*status != 0) {+    /* error */+    return 0;+  }+  /* success */+  return (lua_gettop(L) - oldsize + 1); /* correct for popped value */+}+++/*+** Auxiliary Library+*/++/*+** newstate+*/+lua_State *hsluaL_newstate()+{+  lua_State *L = luaL_newstate();++  /* add error value */+  lua_createtable(L, 0, 0);+  lua_setfield(L, LUA_REGISTRYINDEX, HSLUA_ERR);++  /* register HaskellFunction userdata metatable */+  hslua_registerhsfunmetatable(L);++  return L;+}+++/*+** tolstring'+*/+int hsluaL__tolstring(lua_State *L)+{+  luaL_tolstring(L, 1, NULL);+  return 1;+}++const char *hsluaL_tolstring(lua_State *L, int index, size_t *len)+{+  lua_pushvalue(L, index);+  lua_pushcfunction(L, hsluaL__tolstring);+  lua_insert(L, -2);+  int res = lua_pcall(L, 1, 1, 0);+  if (res != 0) {+    /* error */+    return NULL;+  }+  return lua_tolstring(L, -1, len);+}

@@ -0,0 +1,33 @@+#include "lua.h"+#include "lauxlib.h"++int hslua_error(lua_State *L);++int hslua_call_hs(lua_State *L);++int hslua_userdata_gc(lua_State *L);++int hslua_compare(lua_State *L, int index1, int index2, int op, int *status);++void hslua_concat(lua_State *L, int n, int *status);++void hslua_getglobal(lua_State *L, const char *name, size_t len, int *status);++void hslua_gettable(lua_State *L, int index, int *status);++void hslua_setglobal(lua_State *L, const char *k, size_t len, int *status);++void hslua_settable(lua_State *L, int index, int *status);++int hslua_next(lua_State *L, int index, int *status);+++/* auxiliary library */+const char *hsluaL_tolstring(lua_State *L, int index, size_t *len);++/*+** function calling+*/++/* Wraps a Haskell function with an userdata object.  */+void hslua_newhsfunwrapper(lua_State *L, HsStablePtr fn);

@@ -0,0 +1,41 @@+#include <HsFFI.h>+#include "hslua.h"+#include "hsludata.h"++/* ***************************************************************+ * Userdata Creation and Garbage Collection+ * ***************************************************************/++/*+** Free stable Haskell pointer in userdata.+**+** The userdata whose contents is garbage collected must be on+** stack index 1 (i.e., the first argument).+*/+int hslua_userdata_gc(lua_State *L)+{+  HsStablePtr *userdata = lua_touserdata(L, 1);+  if (userdata) {+    hs_free_stable_ptr(*userdata);+  }+  return 0;+}++/*+** Creates a new userdata metatable for Haskell objects, or gets+** is from the registry if possible.+*/+int hslua_newudmetatable(lua_State *L, const char *tname)+{+  int created = luaL_newmetatable(L, tname);+  if (created) {+    /* Prevent accessing or changing the metatable with+     * getmetatable/setmetatable. */+    lua_pushboolean(L, 1);+    lua_setfield(L, -2, "__metatable");+    /* Mark objects for finalization when collecting garbage. */+    lua_pushcfunction(L, &hslua_userdata_gc);+    lua_setfield(L, -2, "__gc");+  }+  return created;+}

@@ -0,0 +1,11 @@+#include <HsFFI.h>+#include <lua.h>++/* ***************************************************************+ * Userdata for Haskell values+ * ***************************************************************/++/*+** Creates a new userdata metatable for Haskell objects.+*/+int hslua_newudmetatable(lua_State *L, const char *tname);

@@ -1,5 +1,6 @@+cabal-version:       2.2 name:                hslua-version:             1.1.2+version:             1.2.0 synopsis:            Bindings to Lua, an embeddable scripting language description:         HsLua provides bindings, wrappers, types, and helper                      functions to bridge Haskell and <https://www.lua.org/ Lua>.@@ -22,16 +23,16 @@ category:            Foreign build-type:          Simple extra-source-files:  cbits/lua-5.3.5/*.h-                     cbits/error-conversion/*.h-                     README.md-                     CHANGELOG.md-                     test/lua/*.lua-cabal-version:       >=1.10+                   , cbits/hslua/*.h+                   , README.md+                   , CHANGELOG.md+                   , test/lua/*.lua tested-with:         GHC == 8.0.2                    , GHC == 8.2.2                    , GHC == 8.4.3                    , GHC == 8.6.5                    , GHC == 8.8.3+                   , GHC == 8.10.1  source-repository head   type:                git@@ -85,6 +86,7 @@  library   exposed-modules:     Foreign.Lua+                     , Foreign.Lua.Call                      , Foreign.Lua.Core                      , Foreign.Lua.Core.Constants                      , Foreign.Lua.Core.Error@@ -94,6 +96,13 @@                      , Foreign.Lua.Module                      , Foreign.Lua.Peek                      , Foreign.Lua.Push+                     , Foreign.Lua.Raw.Auxiliary+                     , Foreign.Lua.Raw.Call+                     , Foreign.Lua.Raw.Constants+                     , Foreign.Lua.Raw.Error+                     , Foreign.Lua.Raw.Functions+                     , Foreign.Lua.Raw.Types+                     , Foreign.Lua.Raw.Userdata                      , Foreign.Lua.Types                      , Foreign.Lua.Types.Peekable                      , Foreign.Lua.Types.Pushable@@ -111,6 +120,17 @@   hs-source-dirs:      src   default-language:    Haskell2010   ghc-options:         -Wall+                       -Wincomplete-record-updates+                       -Wnoncanonical-monad-instances+                       -Wredundant-constraints+  if impl(ghc >= 8.2)+    ghc-options:         -Wcpp-undef+                         -Werror=missing-home-modules+  if impl(ghc >= 8.4)+    ghc-options:         -Widentities+                         -Wincomplete-uni-patterns+                         -Wpartial-fields+                         -fhide-source-paths   default-extensions:  CApiFFI                      , ForeignFunctionInterface                      , LambdaCase@@ -120,9 +140,10 @@                      , FlexibleContexts                      , FlexibleInstances                      , ScopedTypeVariables-  c-sources:           cbits/error-conversion/error-conversion.c-  include-dirs:        cbits/error-conversion-+  c-sources:           cbits/hslua/hsludata.c+                     , cbits/hslua/hslcall.c+                     , cbits/hslua/hslua.c+  include-dirs:        cbits/hslua   if flag(system-lua) || flag(pkg-config)     if flag(pkg-config)       pkgconfig-depends: lua5.3@@ -205,8 +226,18 @@   main-is:             test-hslua.hs   hs-source-dirs:      test   ghc-options:         -Wall -threaded+                       -Wincomplete-record-updates+                       -Wnoncanonical-monad-instances+  if impl(ghc >= 8.2)+    ghc-options:         -Wcpp-undef+  if impl(ghc >= 8.4)+    ghc-options:         -Wincomplete-uni-patterns+                         -Widentities+                         -Werror=missing-home-modules+                         -fhide-source-paths   default-language:    Haskell2010   other-modules:       Foreign.LuaTests+                     , Foreign.Lua.CallTests                      , Foreign.Lua.CoreTests                      , Foreign.Lua.Core.AuxiliaryTests                      , Foreign.Lua.Core.ErrorTests

@@ -0,0 +1,301 @@+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-|+Module      : Foreign.Lua.Call+Copyright   : © 2020 Albert Krewinkel+License     : MIT+Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de>+Stability   : alpha+Portability : Portable++Marshaling and documenting Haskell functions.+-}+module Foreign.Lua.Call+  ( HaskellFunction (..)+  , toHsFnPrecursor+  , toHsFnPrecursorWithStartIndex+  , applyParameter+  , returnResult+  , Parameter (..)+  , FunctionResult (..)+  , FunctionResults+    -- * Operators+  , (<#>)+  , (=#>)+  , (#?)+    -- * Documentation+  , FunctionDoc (..)+  , ParameterDoc (..)+  , FunctionResultDoc (..)+  , render+    -- * Pushing to Lua+  , pushHaskellFunction+    -- * Convenience functions+  , parameter+  , optionalParameter+  , functionResult+  ) where++import Control.Monad.Except+import Data.Text (Text)+import Foreign.Lua.Core as Lua+import Foreign.Lua.Core.Types (liftLua)+import Foreign.Lua.Peek+import Foreign.Lua.Push+import Foreign.Lua.Raw.Call (hslua_pushhsfunction)+import qualified Data.Text as T++-- | Lua operation with an explicit error type and state (i.e.,+-- without exceptions).+type LuaExcept a = ExceptT PeekError Lua a+++--+-- Function components+--++-- | Result of a call to a Haskell function.+data FunctionResult a+  = FunctionResult+  { fnResultPusher :: Pusher a+  , fnResultDoc :: FunctionResultDoc+  }++-- | List of function results in the order in which they are+-- returned in Lua.+type FunctionResults a = [FunctionResult a]++-- | Function parameter.+data Parameter a = Parameter+  { parameterPeeker :: Peeker a+  , parameterDoc    :: ParameterDoc+  }++-- | Haskell equivallent to CFunction, i.e., function callable+-- from Lua.+data HaskellFunction = HaskellFunction+  { callFunction :: Lua NumResults+  , functionDoc :: Maybe FunctionDoc+  }++--+-- Documentation+--++-- | Documentation for a Haskell function+data FunctionDoc = FunctionDoc+  { functionDescription :: Text+  , parameterDocs       :: [ParameterDoc]+  , functionResultDocs  :: [FunctionResultDoc]+  }+  deriving (Eq, Ord, Show)++-- | Documentation for function parameters.+data ParameterDoc = ParameterDoc+  { parameterName :: Text+  , parameterType :: Text+  , parameterDescription :: Text+  , parameterIsOptional :: Bool+  }+  deriving (Eq, Ord, Show)++-- | Documentation for the result of a function.+data FunctionResultDoc = FunctionResultDoc+  { functionResultType :: Text+  , functionResultDescription :: Text+  }+  deriving (Eq, Ord, Show)+++--+-- Haskell function building+--++-- | Helper type used to create 'HaskellFunction's.+data HsFnPrecursor a = HsFnPrecursor+  { hsFnPrecursorAction :: LuaExcept a+  , hsFnMaxParameterIdx :: StackIndex+  , hsFnParameterDocs :: [ParameterDoc]+  }+  deriving (Functor)++-- | Create a HaskellFunction precursor from a pure function.+toHsFnPrecursor :: a -> HsFnPrecursor a+toHsFnPrecursor = toHsFnPrecursorWithStartIndex (StackIndex 0)++toHsFnPrecursorWithStartIndex :: StackIndex -> a -> HsFnPrecursor a+toHsFnPrecursorWithStartIndex idx f = HsFnPrecursor+  { hsFnPrecursorAction = return f+  , hsFnMaxParameterIdx = idx+  , hsFnParameterDocs = mempty+  }++-- | Partially apply a parameter.+applyParameter :: HsFnPrecursor (a -> b)+               -> Parameter a+               -> HsFnPrecursor b+applyParameter bldr param = do+  let action = hsFnPrecursorAction bldr+  let i = hsFnMaxParameterIdx bldr + 1+  let context = "retrieving function argument " <>+        (parameterName . parameterDoc) param+  let nextAction f = withExceptT (pushMsg context) $ do+        x <- ExceptT $ parameterPeeker param i+        return $ f x+  HsFnPrecursor+    { hsFnPrecursorAction = action >>= nextAction+    , hsFnMaxParameterIdx = i+    , hsFnParameterDocs = parameterDoc param : hsFnParameterDocs bldr+    }++-- | Take a 'HaskellFunction' precursor and convert it into a full+-- 'HaskellFunction', using the given 'FunctionResult's to return+-- the result to Lua.+returnResults :: HsFnPrecursor a+              -> FunctionResults a+              -> HaskellFunction+returnResults bldr fnResults = HaskellFunction+  { callFunction = do+      hsResult <- runExceptT $ hsFnPrecursorAction bldr+      case hsResult of+        Left err -> do+          pushString $ formatPeekError err+          Lua.error+        Right x -> do+          forM_ fnResults $ \(FunctionResult push _) -> push x+          return $ NumResults (fromIntegral $ length fnResults)++  , functionDoc = Just $ FunctionDoc+    { functionDescription = ""+    , parameterDocs = reverse $ hsFnParameterDocs bldr+    , functionResultDocs = map fnResultDoc fnResults+    }+  }++-- | Like @'returnResult'@, but returns only a single result.+returnResult :: HsFnPrecursor a+             -> FunctionResult a+             -> HaskellFunction+returnResult bldr = returnResults bldr . (:[])++-- | Updates the description of a Haskell function. Leaves the function+-- unchanged if it has no documentation.+updateFunctionDescription :: HaskellFunction -> Text -> HaskellFunction+updateFunctionDescription fn desc =+  case functionDoc fn of+    Nothing -> fn+    Just fnDoc ->+      fn { functionDoc = Just $ fnDoc { functionDescription = desc} }++--+-- Operators+--++infixl 8 <#>, =#>, #?++-- | Inline version of @'applyParameter'@.+(<#>) :: HsFnPrecursor (a -> b)+      -> Parameter a+      -> HsFnPrecursor b+(<#>) = applyParameter++-- | Inline version of @'returnResult'@.+(=#>) :: HsFnPrecursor a+      -> FunctionResults a+      -> HaskellFunction+(=#>) = returnResults++-- | Inline version of @'updateFunctionDescription'@.+(#?) :: HaskellFunction -> Text -> HaskellFunction+(#?) = updateFunctionDescription++--+-- Render documentation+--++render :: FunctionDoc -> Text+render (FunctionDoc desc paramDocs resultDoc) =+  (if T.null desc then "" else desc <> "\n\n") <>+  renderParamDocs paramDocs <>+  case resultDoc of+    [] -> ""+    rd -> "\nReturns:\n\n" <> T.intercalate "\n" (map renderResultDoc rd)++renderParamDocs :: [ParameterDoc] -> Text+renderParamDocs pds = "Parameters:\n\n" <>+  T.intercalate "\n" (map renderParamDoc pds)++renderParamDoc :: ParameterDoc -> Text+renderParamDoc pd = mconcat+  [ parameterName pd+  ,  "\n:   "+  , parameterDescription pd+  , " (", parameterType pd, ")\n"+  ]++renderResultDoc :: FunctionResultDoc -> Text+renderResultDoc rd = mconcat+  [ " - "+  , functionResultDescription rd+  , " (", functionResultType rd, ")\n"+  ]++--+-- Push to Lua+--++pushHaskellFunction :: HaskellFunction -> Lua ()+pushHaskellFunction fn = do+  errConv <- Lua.errorConversion+  let hsFn = flip (runWithConverter errConv) $ callFunction fn+  liftLua $ \l -> hslua_pushhsfunction l hsFn++--+-- Convenience functions+--++-- | Creates a parameter.+parameter :: Peeker a     -- ^ method to retrieve value from Lua+          -> Text         -- ^ expected Lua type+          -> Text         -- ^ parameter name+          -> Text         -- ^ parameter description+          -> Parameter a+parameter peeker type_ name desc = Parameter+  { parameterPeeker = peeker+  , parameterDoc = ParameterDoc+    { parameterName = name+    , parameterDescription = desc+    , parameterType = type_+    , parameterIsOptional = False+    }+  }++-- | Creates an optional parameter.+optionalParameter :: Peeker a     -- ^ method to retrieve the value from Lua+                  -> Text         -- ^ expected Lua type+                  -> Text         -- ^ parameter name+                  -> Text         -- ^ parameter description+                  -> Parameter (Maybe a)+optionalParameter peeker type_ name desc = Parameter+  { parameterPeeker = optional peeker+  , parameterDoc = ParameterDoc+    { parameterName = name+    , parameterDescription = desc+    , parameterType = type_+    , parameterIsOptional = True+    }+  }++-- | Creates a function result.+functionResult :: Pusher a        -- ^ method to push the Haskell result to Lua+               -> Text            -- ^ Lua type of result+               -> Text            -- ^ result description+               -> FunctionResults a+functionResult pusher type_ desc = (:[]) $ FunctionResult+  { fnResultPusher = pusher+  , fnResultDoc = FunctionResultDoc+    { functionResultType = type_+    , functionResultDescription = desc+    }+  }

@@ -30,10 +30,12 @@   , Lua.Number (..)   -- ** Stack index   , StackIndex (..)+  , nth   , nthFromBottom   , nthFromTop   , stackTop   , stackBottom+  , top   -- ** Number of arguments and return values   , NumArgs (..)   , NumResults (..)

@@ -0,0 +1,259 @@+{-# 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 s = do+  loadRes <- loadstring s+  if loadRes == Lua.OK+    then Lua.pcall 0 multret Nothing+    else return 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 fp = do+  loadRes <- loadfile fp+  if loadRes == Lua.OK+    then Lua.pcall 0 multret Nothing+    else return 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 obj e = liftLua $ \l ->+  withCString e $ fmap Lua.toType . luaL_getmetafield l 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' tname = liftLua $ \l ->+  withCString tname $ fmap Lua.toType . luaL_getmetatable l++-- | Push referenced value from the table at the given index.+getref :: StackIndex -> Reference -> Lua ()+getref idx ref' = Lua.rawgeti idx (fromIntegral (Lua.fromReference 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 idx fname = do+  -- This is a reimplementation of luaL_getsubtable from lauxlib.c.+  idx' <- Lua.absindex idx+  Lua.pushstring (Utf8.fromString fname)+  Lua.gettable idx'+  isTbl <- Lua.istable Lua.stackTop+  if isTbl+    then return True+    else do+      Lua.pop 1+      Lua.newtable+      Lua.pushvalue Lua.stackTop -- copy to be left at top+      Lua.setfield idx' fname+      return 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 bs name = liftLua $ \l ->+  B.useAsCStringLen bs $ \(str, len) ->+  withCString name+    (fmap Lua.toStatus . luaL_loadbuffer l str (fromIntegral 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 fp = Lua.liftIO contentOrError >>= \case+  Right script -> loadbuffer script ("@" <> fp)+  Left e -> do+    Lua.pushstring (Utf8.fromString (show e))+    return Lua.ErrFile+ where+  contentOrError :: IO (Either IOException ByteString)+  contentOrError = try (B.readFile 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 s = loadbuffer s (Utf8.toString 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 tname = liftLua $ \l ->+  Lua.fromLuaBool <$> withCString tname (luaL_newmetatable 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 = 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 t = liftLua $ \l -> Lua.toReference <$> luaL_ref l 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' n = do+  l <- Lua.state+  e2e <- Lua.errorToException <$> Lua.errorConversion+  Lua.liftIO $ alloca $ \lenPtr -> do+    cstr <- hsluaL_tolstring l n lenPtr+    if cstr == nullPtr+      then e2e l+      else do+        cstrLen <- Storable.peek lenPtr+        B.packCStringLen (cstr, fromIntegral 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 l1 msg level = liftLua $ \l ->+  case msg of+    Nothing -> luaL_traceback l l1 nullPtr (fromIntegral level)+    Just msg' -> withCString msg' $ \cstr ->+      luaL_traceback l l1 cstr (fromIntegral 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 idx r = liftLua $ \l ->+  luaL_unref l idx (Lua.fromReference r)

@@ -1,335 +0,0 @@-{-# LANGUAGE CPP #-}-{-# 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 ( CChar, CInt (CInt), CSize (CSize), CString, withCString )-import Foreign.Lua.Core.Constants (multret, registryindex)-import Foreign.Lua.Core.Error (hsluaErrorRegistryField)-import Foreign.Lua.Core.Types (Lua, Reference, StackIndex, Status, liftLua)-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--#ifndef HARDCODE_REG_KEYS-import System.IO.Unsafe (unsafePerformIO)-import qualified Foreign.C as C-#endif--##ifdef ALLOW_UNSAFE_GC-##define SAFTY unsafe-##else-##define SAFTY safe-##endif-------------------------------------------------------------------------------------- * The Auxiliary Library---- | Key, in the registry, for table of loaded modules.-loadedTableRegistryField :: String-#ifdef HARDCODE_REG_KEYS-loadedTableRegistryField = "_LOADED"-#else-loadedTableRegistryField = unsafePerformIO (C.peekCString c_loaded_table)-{-# NOINLINE loadedTableRegistryField #-}--foreign import capi "lauxlib.h value LUA_LOADED_TABLE"-  c_loaded_table :: CString-#endif---- | Key, in the registry, for table of preloaded loaders.-preloadTableRegistryField :: String-#ifdef HARDCODE_REG_KEYS-preloadTableRegistryField = "_PRELOAD"-#else-preloadTableRegistryField = unsafePerformIO (C.peekCString c_preload_table)-{-# NOINLINE preloadTableRegistryField #-}--foreign import capi "lauxlib.h value LUA_PRELOAD_TABLE"-  c_preload_table :: CString-#endif---- | 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 s = do-  loadRes <- loadstring s-  if loadRes == Lua.OK-    then Lua.pcall 0 multret Nothing-    else return 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 fp = do-  loadRes <- loadfile fp-  if loadRes == Lua.OK-    then Lua.pcall 0 multret Nothing-    else return 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 obj e = liftLua $ \l ->-  withCString e $ fmap Lua.toType . luaL_getmetafield l obj--foreign import capi SAFTY "lauxlib.h luaL_getmetafield"-  luaL_getmetafield :: Lua.State -> StackIndex -> CString -> IO Lua.TypeCode---- | 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' tname = liftLua $ \l ->-  withCString tname $ fmap Lua.toType . luaL_getmetatable l--foreign import capi SAFTY "lauxlib.h luaL_getmetatable"-  luaL_getmetatable :: Lua.State -> CString -> IO Lua.TypeCode---- | Push referenced value from the table at the given index.-getref :: StackIndex -> Reference -> Lua ()-getref idx ref' = Lua.rawgeti idx (fromIntegral (Lua.fromReference 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 idx fname = do-  -- This is a reimplementation of luaL_getsubtable from lauxlib.c.-  idx' <- Lua.absindex idx-  Lua.pushstring (Utf8.fromString fname)-  Lua.gettable idx'-  isTbl <- Lua.istable Lua.stackTop-  if isTbl-    then return True-    else do-      Lua.pop 1-      Lua.newtable-      Lua.pushvalue Lua.stackTop -- copy to be left at top-      Lua.setfield idx' fname-      return 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 bs name = liftLua $ \l ->-  B.useAsCStringLen bs $ \(str, len) ->-  withCString name-    (fmap Lua.toStatus . luaL_loadbuffer l str (fromIntegral len))--foreign import capi SAFTY "lauxlib.h luaL_loadbuffer"-  luaL_loadbuffer :: Lua.State -> Ptr CChar -> CSize -> CString-                  -> IO Lua.StatusCode----- | 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 fp = Lua.liftIO contentOrError >>= \case-  Right script -> loadbuffer script ("@" <> fp)-  Left e -> do-    Lua.pushstring (Utf8.fromString (show e))-    return Lua.ErrFile- where-  contentOrError :: IO (Either IOException ByteString)-  contentOrError = try (B.readFile 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 s = loadbuffer s (Utf8.toString 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 tname = liftLua $ \l ->-  Lua.fromLuaBool <$> withCString tname (luaL_newmetatable l)--foreign import ccall SAFTY "lauxlib.h luaL_newmetatable"-  luaL_newmetatable :: Lua.State -> CString -> IO Lua.LuaBool----- | 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 = do-  l <- luaL_newstate-  Lua.unsafeRunWith l $ do-    Lua.createtable 0 0-    Lua.setfield registryindex hsluaErrorRegistryField-    return l--foreign import ccall unsafe "lauxlib.h luaL_newstate"-  luaL_newstate :: IO Lua.State----- | 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 t = liftLua $ \l -> Lua.toReference <$> luaL_ref l t--foreign import ccall SAFTY "lauxlib.h luaL_ref"-  luaL_ref :: Lua.State -> StackIndex -> IO CInt----- | 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' n = do-  l <- Lua.state-  e2e <- Lua.errorToException <$> Lua.errorConversion-  Lua.liftIO $ alloca $ \lenPtr -> do-    cstr <- hsluaL_tolstring l n lenPtr-    if cstr == nullPtr-      then e2e l-      else do-        cstrLen <- Storable.peek lenPtr-        B.packCStringLen (cstr, fromIntegral cstrLen)--foreign import ccall safe "error-conversion.h hsluaL_tolstring"-  hsluaL_tolstring :: Lua.State -> StackIndex -> Ptr CSize -> IO (Ptr CChar)----- | 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 l1 msg level = liftLua $ \l ->-  case msg of-    Nothing -> luaL_traceback l l1 nullPtr (fromIntegral level)-    Just msg' -> withCString msg' $ \cstr ->-      luaL_traceback l l1 cstr (fromIntegral level)--foreign import capi unsafe "lauxlib.h luaL_traceback"-  luaL_traceback :: Lua.State -> Lua.State -> CString -> CInt -> IO ()----- | 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 idx r = liftLua $ \l ->-  luaL_unref l idx (Lua.fromReference r)--foreign import ccall SAFTY "lauxlib.h luaL_unref"-  luaL_unref :: Lua.State -> StackIndex -> CInt -> IO ()

@@ -0,0 +1,22 @@+{-|+Module      : Foreign.Lua.Core.Constants+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 : ForeignFunctionInterface++Lua constants. This module was moved to+@'Foreign.Lua.Raw.Constants'@. It now merely exists for backwards+compatibility and will be removed in the future.+-}+module Foreign.Lua.Core.Constants+  ( multret+  , registryindex+  , refnil+  , noref+  ) where++import Foreign.Lua.Raw.Constants

@@ -1,41 +0,0 @@-{-|-Module      : Foreign.Lua.Core.Constants-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 : ForeignFunctionInterface--Lua constants--}-module Foreign.Lua.Core.Constants-  ( multret-  , registryindex-  , refnil-  , noref-  ) where--import Foreign.Lua.Core.Types--#include "lua.h"-#include "lauxlib.h"---- | Alias for C constant @LUA_MULTRET@. See--- <https://www.lua.org/manual/5.3/#lua_call lua_call>.-multret :: NumResults-multret = NumResults $ #{const LUA_MULTRET}---- | Alias for C constant @LUA_REGISTRYINDEX@. See--- <https://www.lua.org/manual/5.3/#3.5 Lua registry>.-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}

@@ -23,30 +23,24 @@   , errorMessage   , try     -- * Helpers for hslua C wrapper functions.-  , Failable (..)-  , fromFailable-  , throwOnError   , throwMessage-  , boolFromFailable-    -- * Signaling errors to Lua-  , hsluaErrorRegistryField+  , liftLuaThrow   ) where  import Control.Applicative (Alternative (..)) import Data.Typeable (Typeable)-import Foreign.C (CChar, CInt (CInt), CSize (CSize))+import Foreign.Lua.Core.Types (Lua)+import Foreign.Lua.Raw.Error (errorMessage)+import Foreign.Lua.Raw.Functions (lua_pushlstring) import Foreign.Marshal.Alloc (alloca)-import Foreign.Ptr (Ptr, nullPtr)-import Foreign.Lua.Core.Types (Lua, StackIndex, fromLuaBool)+import Foreign.Ptr +import qualified Data.ByteString.Unsafe as B import qualified Control.Exception as E import qualified Control.Monad.Catch as Catch-import qualified Data.ByteString as B-import qualified Data.ByteString.Char8 as Char8-import qualified Data.ByteString.Unsafe as B-import qualified Foreign.Storable as Storable import qualified Foreign.Lua.Core.Types as Lua import qualified Foreign.Lua.Utf8 as Utf8+import qualified Foreign.Storable as F  -- | Exceptions raised by Lua-related operations. newtype Exception = Exception { exceptionMessage :: String}@@ -92,6 +86,15 @@ throwTopMessage :: Lua a throwTopMessage = throwErrorAsException +-- | Helper function which uses proper error-handling to throw an+-- exception with the given message.+throwMessage :: String -> Lua a+throwMessage msg = do+  Lua.liftLua $ \l ->+    B.unsafeUseAsCStringLen (Utf8.fromString msg) $ \(msgPtr, z) ->+      lua_pushlstring l msgPtr (fromIntegral z)+  Lua.errorConversion >>= Lua.liftLua . Lua.errorToException+ instance Alternative Lua where   empty = throwMessage "empty"   x <|> y = do@@ -108,66 +111,15 @@   msg <- Lua.liftIO (errorMessage l)   Catch.throwM $ Exception (Utf8.toString msg) --- | Helper function which uses proper error-handling to throw an--- exception with the given message.-throwMessage :: String -> Lua a-throwMessage msg = do-  Lua.liftLua $ \l ->-    B.unsafeUseAsCStringLen (Utf8.fromString msg) $ \(msgPtr, z) ->-      lua_pushlstring l msgPtr (fromIntegral z)-  Lua.errorConversion >>= Lua.liftLua . Lua.errorToException---- | Retrieve and pop the top object as an error message. This is very similar--- to tostring', but ensures that we don't recurse if getting the message--- failed.-errorMessage :: Lua.State -> IO B.ByteString-errorMessage l = alloca $ \lenPtr -> do-  cstr <- hsluaL_tolstring l Lua.stackTop lenPtr-  if cstr == nullPtr-    then return $ Char8.pack ("An error occurred, but the error object " ++-                              "cannot be converted into a string.")-    else do-      cstrLen <- Storable.peek lenPtr-      msg <- B.packCStringLen (cstr, fromIntegral cstrLen)-      lua_pop l 2-      return msg--foreign import ccall safe "error-conversion.h hsluaL_tolstring"-  hsluaL_tolstring :: Lua.State -> StackIndex -> Ptr CSize -> IO (Ptr CChar)--foreign import capi unsafe "lua.h lua_pop"-  lua_pop :: Lua.State -> CInt -> IO ()--foreign import capi unsafe "lua.h lua_pushlstring"-  lua_pushlstring :: Lua.State -> Ptr CChar -> CSize -> IO ()---- | Registry field under which the special HsLua error indicator is stored.-hsluaErrorRegistryField :: String-hsluaErrorRegistryField = "HSLUA_ERR"------- * Custom protocol to communicate with hslua C wrapper functions.------- | CInt value or an error, using the convention that value below zero indicate--- an error. Values greater than zero are used verbatim. The phantom type is--- used for additional type safety and gives the type into which the wrapped--- CInt should be converted.-newtype Failable a = Failable CInt---- | Convert from Failable to target type, throwing an error if the value--- indicates a failure.-fromFailable :: (CInt -> a) -> Failable a -> Lua a-fromFailable fromCInt (Failable x) =-  if x < 0-  then throwTopMessage-  else return (fromCInt x)---- | Throw a Haskell exception if the computation signaled a failure.-throwOnError :: Failable () -> Lua ()-throwOnError = fromFailable (const ())---- | Convert lua boolean to Haskell Bool, throwing an exception if the return--- value indicates that an error had happened.-boolFromFailable :: Failable Lua.LuaBool -> Lua Bool-boolFromFailable = fmap fromLuaBool . fromFailable Lua.LuaBool+-- | Takes a failable HsLua function and transforms it into a+-- monadic 'Lua' operation. Throws an exception if an error+-- occured.+liftLuaThrow :: (Lua.State -> Ptr Lua.StatusCode -> IO a) -> Lua a+liftLuaThrow f = do+  (result, status) <- Lua.liftLua $ \l -> alloca $ \statusPtr -> do+    result <- f l statusPtr+    status <- Lua.toStatus <$> F.peek statusPtr+    return (result, status)+  if status == Lua.OK+    then return result+    else throwTopMessage

@@ -142,8 +142,8 @@ -- This is a wrapper function of -- <https://www.lua.org/manual/5.3/manual.html#lua_compare lua_compare>. compare :: StackIndex -> StackIndex -> RelationalOperator -> Lua Bool-compare idx1 idx2 relOp = boolFromFailable =<< do-  liftLua $ \l -> hslua_compare l idx1 idx2 (fromRelationalOperator relOp)+compare idx1 idx2 relOp = fromLuaBool <$> do+  liftLuaThrow $ \l -> hslua_compare l idx1 idx2 (fromRelationalOperator relOp)  -- | Concatenates the @n@ values at the top of the stack, pops them, and leaves -- the result at the top. If @n@ is 1, the result is the single value on the@@ -155,7 +155,7 @@ -- This is a wrapper function of -- <https://www.lua.org/manual/5.3/manual.html#lua_concat lua_concat>. concat :: NumArgs -> Lua ()-concat n = throwOnError =<< liftLua (`hslua_concat` n)+concat n = liftLuaThrow (`hslua_concat` n)  -- | Copies the element at index @fromidx@ into the valid index @toidx@, -- replacing the value at that position. Values at other positions are not@@ -256,9 +256,9 @@ -- Wrapper of -- <https://www.lua.org/manual/5.3/manual.html#lua_getglobal lua_getglobal>. getglobal :: String -> Lua ()-getglobal name = throwOnError <=< liftLua $ \l ->+getglobal name = liftLuaThrow $ \l status' ->   C.withCStringLen name $ \(namePtr, len) ->-  hslua_getglobal l namePtr (fromIntegral len)+  hslua_getglobal l namePtr (fromIntegral len) status'  -- | If the value at the given index has a metatable, the function pushes that -- metatable onto the stack and returns @True@. Otherwise, the function returns@@ -283,8 +283,7 @@ -- See also: -- <https://www.lua.org/manual/5.3/manual.html#lua_gettable lua_gettable>. gettable :: StackIndex -> Lua ()-gettable n = throwOnError =<<-  liftLua (\l -> hslua_gettable l n)+gettable n = liftLuaThrow (\l -> hslua_gettable l n)  -- | Returns the index of the top element in the stack. Because indices start at -- 1, this result is equal to the number of elements in the stack (and so 0@@ -473,7 +472,7 @@ -- See also: -- <https://www.lua.org/manual/5.3/manual.html#lua_next lua_next>. next :: StackIndex -> Lua Bool-next idx = boolFromFailable =<< liftLua (\l -> hslua_next l idx)+next idx = fromLuaBool <$> liftLuaThrow (\l -> hslua_next l idx)  -- | Opens all standard Lua libraries into the current state and sets each -- library name as a global value.@@ -566,7 +565,7 @@ -- -- See also: <https://www.lua.org/manual/5.3/manual.html#lua_pop lua_pop>. pop :: StackIndex -> Lua ()-pop n = settop (-n - 1)+pop n = liftLua $ \l -> lua_pop l n  -- | Pushes a boolean value with the given value onto the stack. --@@ -774,9 +773,9 @@ -- See also: -- <https://www.lua.org/manual/5.3/manual.html#lua_setglobal lua_setglobal>. setglobal :: String -> Lua ()-setglobal name = throwOnError <=< liftLua $ \l ->+setglobal name = liftLuaThrow $ \l status' ->   C.withCStringLen name $ \(namePtr, nameLen) ->-  hslua_setglobal l namePtr (fromIntegral nameLen)+  hslua_setglobal l namePtr (fromIntegral nameLen) status'  -- | Pops a table from the stack and sets it as the new metatable for the value -- at the given index.@@ -801,8 +800,7 @@ -- See also: -- <https://www.lua.org/manual/5.3/manual.html#lua_settable lua_settable>. settable :: StackIndex -> Lua ()-settable index = throwOnError =<<-  liftLua (\l -> hslua_settable l index)+settable index = liftLuaThrow $ \l -> hslua_settable l index  -- | Accepts any index, or 0, and sets the stack top to this index. If the new -- top is larger than the old one, then the new elements are filled with nil. If

@@ -0,0 +1,21 @@+{-|+Module      : Foreign.Lua.Core.RawBindings+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 : ForeignFunctionInterface++Haskell bindings to Lua C API functions.++This module was moved to @'Foreign.Lua.Raw.Functions'@. It now+merely exists for backwards compatibility and will be removed in+the future.+-}+module Foreign.Lua.Core.RawBindings+  ( module Foreign.Lua.Raw.Functions+  ) where++import Foreign.Lua.Raw.Functions

@@ -1,389 +0,0 @@-{-# LANGUAGE CPP #-}-{-|-Module      : Foreign.Lua.Core.RawBindings-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 : ForeignFunctionInterface--Haskell bindings to lua C API functions.--}-module Foreign.Lua.Core.RawBindings where--import Foreign.C-import Foreign.Lua.Core.Error (Failable (Failable))-import Foreign.Lua.Core.Types as Lua-import Foreign.Ptr--##ifdef ALLOW_UNSAFE_GC-##define SAFTY unsafe-##else-##define SAFTY safe-##endif---- TODO: lua_getallocf, lua_setallocf--- TODO: Debugger functions---- Some of the Lua functions may call a Haskell function, and trigger--- garbage collection, rescheduling etc. This means we must declare these--- functions as 'safe'.-------------------------------------------------------------------------------------- * State manipulation---- lua_newstate is currently not supported.---- | See <https://www.lua.org/manual/5.3/manual.html#lua_close lua_close>-foreign import ccall "lua.h lua_close"-  lua_close :: Lua.State -> IO ()---- lua_newthread is currently not supported.-------------------------------------------------------------------------------------- * Basic stack manipulation---- | See <https://www.lua.org/manual/5.3/manual.html#lua_absindex lua_absindex>-foreign import ccall unsafe "lua.h lua_absindex"-  lua_absindex :: Lua.State -> StackIndex -> IO StackIndex---- | See <https://www.lua.org/manual/5.3/manual.html#lua_gettop lua_gettop>-foreign import ccall unsafe "lua.h lua_gettop"-  lua_gettop :: Lua.State -> IO StackIndex---- | See <https://www.lua.org/manual/5.3/manual.html#lua_settop lua_settop>-foreign import ccall SAFTY "lua.h lua_settop"-  lua_settop :: Lua.State -> StackIndex -> IO ()---- | See <https://www.lua.org/manual/5.3/manual.html#lua_pushvalue lua_pushvalue>-foreign import ccall SAFTY "lua.h lua_pushvalue"-  lua_pushvalue :: Lua.State -> StackIndex -> IO ()---- | See <https://www.lua.org/manual/5.3/manual.html#lua_copy lua_copy>-foreign import ccall SAFTY "lua.h lua_copy"-  lua_copy :: Lua.State -> StackIndex -> StackIndex -> IO ()---- | See <https://www.lua.org/manual/5.2/manual.html#lua_remove lua_remove>-foreign import capi SAFTY "lua.h lua_remove"-  lua_remove :: Lua.State -> StackIndex -> IO ()---- | See <https://www.lua.org/manual/5.2/manual.html#lua_insert lua_insert>-foreign import capi SAFTY "lua.h lua_insert"-  lua_insert :: Lua.State -> StackIndex -> IO ()---- | See <https://www.lua.org/manual/5.2/manual.html#lua_replace lua_replace>-foreign import capi SAFTY "lua.h lua_replace"-  lua_replace :: Lua.State -> StackIndex -> IO ()---- | See <https://www.lua.org/manual/5.3/manual.html#lua_checkstack lua_checkstack>-foreign import capi SAFTY "lua.h lua_checkstack"-  lua_checkstack :: Lua.State -> CInt -> IO LuaBool---- lua_xmove is currently not supported.-------------------------------------------------------------------------------------- * Stack access functions---- | See <https://www.lua.org/manual/5.3/manual.html#lua_isnumber lua_isnumber>-foreign import ccall SAFTY "lua.h lua_isnumber"-  lua_isnumber :: Lua.State -> StackIndex -> IO LuaBool---- | See <https://www.lua.org/manual/5.3/manual.html#lua_isinteger lua_isinteger>-foreign import ccall SAFTY "lua.h lua_isinteger"-  lua_isinteger :: Lua.State -> StackIndex -> IO LuaBool---- | See <https://www.lua.org/manual/5.3/manual.html#lua_isstring lua_isstring>-foreign import ccall SAFTY "lua.h lua_isstring"-  lua_isstring :: Lua.State -> StackIndex -> IO LuaBool---- | See <https://www.lua.org/manual/5.3/manual.html#lua_iscfunction lua_iscfunction>-foreign import ccall SAFTY "lua.h lua_iscfunction"-  lua_iscfunction :: Lua.State -> StackIndex -> IO LuaBool---- | See <https://www.lua.org/manual/5.3/manual.html#lua_isuserdata lua_isuserdata>-foreign import ccall SAFTY "lua.h lua_isuserdata"-  lua_isuserdata :: Lua.State -> StackIndex -> IO LuaBool---- | See <https://www.lua.org/manual/5.3/manual.html#lua_type lua_type>-foreign import ccall SAFTY "lua.h lua_type"-  lua_type :: Lua.State -> StackIndex -> IO TypeCode---- | See <https://www.lua.org/manual/5.3/manual.html#lua_typename lua_typename>-foreign import ccall SAFTY "lua.h lua_typename"-  lua_typename :: Lua.State -> TypeCode -> IO CString---- lua_compare is unsafe (might cause a longjmp), use hslua_compare instead.---- | Wrapper around <https://lua.org/manual/5.3/manual.html#lua_compare \--- @lua_compare@> which catches any @longjmp@s.-foreign import ccall "error-conversion.h hslua_compare"-  hslua_compare :: Lua.State -> StackIndex -> StackIndex -> CInt-                -> IO (Failable LuaBool)---- | See <https://www.lua.org/manual/5.3/manual.html#lua_rawequal lua_rawequal>-foreign import ccall SAFTY "lua.h lua_rawequal"-  lua_rawequal :: Lua.State -> StackIndex -> StackIndex -> IO LuaBool------- Type coercion------ | See <https://www.lua.org/manual/5.3/manual.html#lua_toboolean lua_toboolean>-foreign import capi SAFTY "lua.h lua_toboolean"-  lua_toboolean :: Lua.State -> StackIndex -> IO LuaBool---- | See <https://www.lua.org/manual/5.3/manual.html#lua_tocfunction lua_tocfunction>-foreign import ccall SAFTY "lua.h lua_tocfunction"-  lua_tocfunction :: Lua.State -> StackIndex -> IO CFunction---- | See <https://www.lua.org/manual/5.3/manual.html#lua_tointegerx lua_tointegerx>-foreign import ccall SAFTY "lua.h lua_tointegerx"-  lua_tointegerx :: Lua.State -> StackIndex -> Ptr LuaBool -> IO Lua.Integer---- | See <https://www.lua.org/manual/5.3/manual.html#lua_tonumberx lua_tonumberx>-foreign import ccall SAFTY "lua.h lua_tonumberx"-  lua_tonumberx :: Lua.State -> StackIndex -> Ptr LuaBool -> IO Lua.Number---- | See <https://www.lua.org/manual/5.3/manual.html#lua_tolstring lua_tolstring>-foreign import ccall SAFTY "lua.h lua_tolstring"-  lua_tolstring :: Lua.State -> StackIndex -> Ptr CSize -> IO (Ptr CChar)---- | See <https://www.lua.org/manual/5.3/manual.html#lua_topointer lua_topointer>-foreign import ccall SAFTY "lua.h lua_topointer"-  lua_topointer :: Lua.State -> StackIndex -> IO (Ptr ())---- | See <https://www.lua.org/manual/5.3/manual.html#lua_tothread lua_tothread>-foreign import ccall SAFTY "lua.h lua_tothread"-  lua_tothread :: Lua.State -> StackIndex -> IO Lua.State---- | See <https://www.lua.org/manual/5.3/manual.html#lua_touserdata lua_touserdata>-foreign import ccall SAFTY "lua.h lua_touserdata"-  lua_touserdata :: Lua.State -> StackIndex -> IO (Ptr a)-------- Object size------- | See <https://www.lua.org/manual/5.3/manual.html#lua_rawlen lua_rawlen>-foreign import ccall SAFTY "lua.h lua_rawlen"-  lua_rawlen :: Lua.State -> StackIndex -> IO CSize-------------------------------------------------------------------------------------- * Push functions---- | See <https://www.lua.org/manual/5.3/manual.html#lua_pushnil lua_pushnil>-foreign import ccall SAFTY "lua.h lua_pushnil"-  lua_pushnil :: Lua.State -> IO ()---- | See <https://www.lua.org/manual/5.3/manual.html#lua_pushnumber lua_pushnumber>-foreign import ccall SAFTY "lua.h lua_pushnumber"-  lua_pushnumber :: Lua.State -> Lua.Number -> IO ()---- | See <https://www.lua.org/manual/5.3/manual.html#lua_pushinteger lua_pushinteger>-foreign import ccall SAFTY "lua.h lua_pushinteger"-  lua_pushinteger :: Lua.State -> Lua.Integer -> IO ()---- | See <https://www.lua.org/manual/5.3/manual.html#lua_pushlstring lua_pushlstring>-foreign import ccall SAFTY "lua.h lua_pushlstring"-  lua_pushlstring :: Lua.State -> Ptr CChar -> CSize -> IO ()---- lua_pushstring is currently not supported. It's difficult to use in a haskell--- context.---- | See <https://www.lua.org/manual/5.3/manual.html#lua_pushcclosure lua_pushcclosure>-foreign import ccall SAFTY "lua.h lua_pushcclosure"-  lua_pushcclosure :: Lua.State -> CFunction -> NumArgs -> IO ()---- | See <https://www.lua.org/manual/5.3/manual.html#lua_pushboolean lua_pushboolean>-foreign import ccall SAFTY "lua.h lua_pushboolean"-  lua_pushboolean :: Lua.State -> LuaBool -> IO ()---- | See <https://www.lua.org/manual/5.3/manual.html#lua_pushlightuserdata lua_pushlightuserdata>-foreign import ccall SAFTY "lua.h lua_pushlightuserdata"-  lua_pushlightuserdata :: Lua.State -> Ptr a -> IO ()---- | See <https://www.lua.org/manual/5.3/manual.html#lua_pushthread lua_pushthread>-foreign import ccall SAFTY "lua.h lua_pushthread"-  lua_pushthread :: Lua.State -> IO CInt-------------------------------------------------------------------------------------- * Get functions---- + lua_gettable is unsafe, use hslua_gettable instead.--- + lua_getglobal is unsafe, use hslua_getglobal instead.--- + lua_getfield is unsafe, we build something equivallent using pushlstring and---   gettable.---- | Wrapper around <https://lua.org/manual/5.3/manual.html#lua_gettable \--- @lua_gettable@> which catches any @longjmp@s.-foreign import ccall "error-conversion.h hslua_gettable"-  hslua_gettable :: Lua.State -> StackIndex -> IO (Failable ())---- | See <https://www.lua.org/manual/5.3/manual.html#lua_rawget lua_rawget>-foreign import ccall SAFTY "lua.h lua_rawget"-  lua_rawget :: Lua.State -> StackIndex -> IO ()---- | See <https://www.lua.org/manual/5.3/manual.html#lua_rawgeti lua_rawgeti>-foreign import ccall SAFTY "lua.h lua_rawgeti"-  lua_rawgeti :: Lua.State -> StackIndex -> Lua.Integer -> IO ()---- | See <https://www.lua.org/manual/5.3/manual.html#lua_createtable lua_createtable>-foreign import ccall SAFTY "lua.h lua_createtable"-  lua_createtable :: Lua.State -> CInt -> CInt -> IO ()---- | See <https://www.lua.org/manual/5.3/manual.html#lua_newuserdata lua_newuserdata>-foreign import ccall SAFTY "lua.h lua_newuserdata"-  lua_newuserdata :: Lua.State -> CSize -> IO (Ptr ())---- | See <https://www.lua.org/manual/5.3/manual.html#lua_getmetatable lua_getmetatable>-foreign import ccall SAFTY "lua.h lua_getmetatable"-  lua_getmetatable :: Lua.State -> StackIndex -> IO LuaBool---- | Wrapper around <https://lua.org/manual/5.3/manual.html#lua_getglobal \--- @lua_getglobal@> which catches any @longjmp@s.-foreign import ccall "error-conversion.h hslua_getglobal"-  hslua_getglobal :: Lua.State -> CString -> CSize -> IO (Failable ())-------------------------------------------------------------------------------------- * Set functions---- lua_settable is unsafe, use hslua_settable instead.--- lua_setfield is unsafe, use hslua_setfield instead.--- lua_setglobal is unsafe, use hslua_setglobal instead.--- lua_setfenv (5.1 only) is not supported.---- | Wrapper around <https://lua.org/manual/5.3/manual.html#lua_settable \--- @lua_settable@> which catches any @longjmp@s.-foreign import ccall "error-conversion.h hslua_settable"-  hslua_settable :: Lua.State -> StackIndex -> IO (Failable ())---- | See <https://www.lua.org/manual/5.3/manual.html#lua_rawset lua_rawset>-foreign import ccall SAFTY "lua.h lua_rawset"-  lua_rawset :: Lua.State -> StackIndex -> IO ()---- | See <https://www.lua.org/manual/5.3/manual.html#lua_rawseti lua_rawseti>-foreign import ccall SAFTY "lua.h lua_rawseti"-  lua_rawseti :: Lua.State -> StackIndex -> Lua.Integer -> IO ()---- | See <https://www.lua.org/manual/5.3/manual.html#lua_setmetatable lua_setmetatable>-foreign import ccall SAFTY "lua.h lua_setmetatable"-  lua_setmetatable :: Lua.State -> StackIndex -> IO ()---- | Wrapper around <https://lua.org/manual/5.3/manual.html#lua_setglobal \--- @lua_setglobal@> which catches any @longjmp@s.-foreign import ccall "error-conversion.h hslua_setglobal"-  hslua_setglobal :: Lua.State -> CString -> CSize -> IO (Failable ())-------------------------------------------------------------------------------------- * \'load\' and \'call\' functions (load and run Lua code)---- lua_call is inherently unsafe, we do not support it.---- | See <https://www.lua.org/manual/5.1/manual.html#lua_pcall lua_pcall>-foreign import capi "lua.h lua_pcall"-  lua_pcall :: Lua.State -> NumArgs -> NumResults -> StackIndex-            -> IO StatusCode---- | See <https://www.lua.org/manual/5.3/manual.html#lua_load lua_load>-foreign import ccall safe "lua.h lua_load"-  lua_load :: Lua.State -> Lua.Reader -> Ptr () -> CString -> CString-           -> IO StatusCode---- currently unsupported:--- lua_dump------------------------------------------------------------------------------------ * Coroutine functions---- lua_yield / lua_yieldk and lua_resume are currently not supported.---- | See <https://www.lua.org/manual/5.3/manual.html#lua_status lua_status>-foreign import ccall unsafe "lua.h lua_status"-  lua_status :: Lua.State -> IO StatusCode------------------------------------------------------------------------------------ * Garbage-collection functions and options---- | See <https://www.lua.org/manual/5.3/manual.html#lua_gc lua_gc>-foreign import ccall "lua.h lua_gc"-  lua_gc :: Lua.State -> CInt -> CInt -> IO CInt------------------------------------------------------------------------------------ * Miscellaneous functions---- lua_error is unsafe, use hslua_error instead.--- lua_next is unsafe, use hslua_next instead.--- lua_concat is unsafe (may trigger a longjmp), use hslua_concat instead.---- | Replacement for <https://lua.org/manual/5.3/manual.html#lua_error \--- @lua_error@>; it uses the HsLua error signaling convention instead of raw--- @longjmp@.-foreign import ccall "error-conversion.h hslua_error"-  hslua_error :: Lua.State -> IO NumResults---- | Wrapper around <https://lua.org/manual/5.3/manual.html#lua_next \--- @lua_next@> which catches any @longjmp@s.-foreign import ccall "error-conversion.h hslua_next"-  hslua_next :: Lua.State -> StackIndex -> IO (Failable LuaBool)---- | Wrapper around <https://lua.org/manual/5.3/manual.html#lua_concat \--- @lua_concat@> which catches any @longjmp@s.-foreign import ccall "error-conversion.h hslua_concat"-  hslua_concat :: Lua.State -> NumArgs -> IO (Failable ())---- | See <https://www.lua.org/manual/5.3/manual.html#lua_pushglobaltable \--- lua_pushglobaltable>-foreign import capi unsafe "lua.h lua_pushglobaltable"-  lua_pushglobaltable :: Lua.State -> IO ()------------------------------------------------------------------------------------ * Lua Libraries---- | See <https://www.lua.org/manual/5.3/manual.html#luaL_openlibs luaL_openlibs>-foreign import ccall unsafe "lualib.h luaL_openlibs"-  luaL_openlibs :: Lua.State -> IO ()---- | Point to function opening the base library.-foreign import ccall unsafe "lualib.h &luaopen_base"-  lua_open_base_ptr :: CFunction---- | Point to function opening the table library.-foreign import ccall unsafe "lualib.h &luaopen_table"-  lua_open_table_ptr :: CFunction---- | Point to function opening the io library.-foreign import ccall unsafe "lualib.h &luaopen_io"-  lua_open_io_ptr :: CFunction---- | Point to function opening the os library.-foreign import ccall unsafe "lualib.h &luaopen_os"-  lua_open_os_ptr :: CFunction---- | Point to function opening the string library.-foreign import ccall unsafe "lualib.h &luaopen_string"-  lua_open_string_ptr :: CFunction---- | Point to function opening the math library.-foreign import ccall unsafe "lualib.h &luaopen_math"-  lua_open_math_ptr :: CFunction---- | Point to function opening the debug library.-foreign import ccall unsafe "lualib.h &luaopen_debug"-  lua_open_debug_ptr :: CFunction---- | Point to function opening the package library.-foreign import ccall unsafe "lualib.h &luaopen_package"-  lua_open_package_ptr :: CFunction

@@ -0,0 +1,178 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE RankNTypes                 #-}+{-|+Module      : Foreign.Lua.Core.Types+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)++The core Lua types, including mappings of Lua types to Haskell.++This module has mostly been moved to @'Foreign.Lua.Raw.Types'@ and+currently re-exports that module. This module might be removed in+the future.+-}+module Foreign.Lua.Core.Types+  ( Lua (..)+  , LuaEnvironment (..)+  , ErrorConversion (..)+  , errorConversion+  , State (..)+  , Reader+  , liftLua+  , liftLua1+  , state+  , runWithConverter+  , unsafeRunWith+  , unsafeErrorConversion+  , GCCONTROL (..)+  , Type (..)+  , TypeCode (..)+  , fromType+  , toType+  , liftIO+  , CFunction+  , LuaBool (..)+  , false+  , true+  , fromLuaBool+  , toLuaBool+  , Integer (..)+  , Number (..)+  , StackIndex (..)+  , nth+  , nthFromBottom+  , nthFromTop+  , stackTop+  , stackBottom+  , top+  , NumArgs (..)+  , NumResults (..)+  , RelationalOperator (..)+  , fromRelationalOperator+  , Status (..)+  , StatusCode (..)+  , toStatus+    -- * References+  , Reference (..)+  , fromReference+  , toReference+  ) where++import Prelude hiding (Integer)++import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow)+import Control.Monad.Reader (ReaderT (..), MonadReader, MonadIO, asks, liftIO)+import Foreign.C (CInt)+import Foreign.Lua.Raw.Types+import Foreign.Lua.Raw.Auxiliary+  ( Reference (..)+  , fromReference+  , toReference+  )++-- | Define the ways in which exceptions and errors are handled.+data ErrorConversion = ErrorConversion+  { errorToException :: forall a . State -> IO a+    -- ^ Translate Lua errors to Haskell exceptions+  , addContextToException :: forall a . String -> Lua a -> Lua a+    -- ^ Add information on the current context to an exception.+  , alternative :: forall a . Lua a -> Lua a -> Lua a+    -- ^ Runs the second computation only if the first fails; returns+    -- the result of the first successful computation, if any.+  , exceptionToError :: Lua NumResults -> Lua NumResults+    -- ^ Translate Haskell exceptions to Lua errors+  }++-- | Environment in which Lua computations are evaluated.+data LuaEnvironment = LuaEnvironment+  { luaEnvErrorConversion :: ErrorConversion+    -- ^ Functions for error and exception handling and conversion+  , luaEnvState :: State+    -- ^ Lua interpreter state+  }++-- | A Lua computation. This is the base type used to run Lua programs of any+-- kind. The Lua state is handled automatically, but can be retrieved via+-- @'state'@.+newtype Lua a = Lua { unLua :: ReaderT LuaEnvironment IO a }+  deriving+    ( Applicative+    , Functor+    , Monad+    , MonadCatch+    , MonadIO+    , MonadMask+    , MonadReader LuaEnvironment+    , MonadThrow+    )++-- | Turn a function of typ @Lua.State -> IO a@ into a monadic Lua operation.+liftLua :: (State -> IO a) -> Lua a+liftLua f = state >>= liftIO . f++-- | Turn a function of typ @Lua.State -> a -> IO b@ into a monadic Lua operation.+liftLua1 :: (State -> a -> IO b) -> a -> Lua b+liftLua1 f x = liftLua $ \l -> f l x++-- | Get the Lua state of this Lua computation.+state :: Lua State+state = asks luaEnvState++-- | Get the error-to-exception function.+errorConversion :: Lua ErrorConversion+errorConversion = asks luaEnvErrorConversion++-- | Run Lua computation with the given Lua state and error-to-exception+-- converter. Any resulting exceptions are left unhandled.+runWithConverter :: ErrorConversion -> State -> Lua a -> IO a+runWithConverter e2e l s =+  runReaderT (unLua s) (LuaEnvironment e2e l)++-- | Run the given operation, but crash if any Haskell exceptions occur.+unsafeRunWith :: State -> Lua a -> IO a+unsafeRunWith = runWithConverter unsafeErrorConversion++-- | Unsafe @'ErrorConversion'@; no proper error handling is attempted,+-- any error leads to a crash.+unsafeErrorConversion :: ErrorConversion+unsafeErrorConversion = ErrorConversion+  { errorToException = const (error "An unrecoverable Lua error occured.")+  , addContextToException = const id+  , alternative = const+  , exceptionToError = id+  }++-- | Stack index of the nth element from the top of the stack.+nthFromTop :: CInt -> StackIndex+nthFromTop n = StackIndex (-n)+{-# INLINABLE nthFromTop #-}++-- | Stack index of the nth element from the top of the stack.+nth :: CInt -> StackIndex+nth = nthFromTop+{-# INLINABLE nth #-}++-- | Stack index of the nth element from the bottom of the stack.+nthFromBottom :: CInt -> StackIndex+nthFromBottom = StackIndex+{-# INLINABLE nthFromBottom #-}++-- | Top of the stack+top :: StackIndex+top = -1+{-# INLINABLE top #-}++-- | Top of the stack+stackTop :: StackIndex+stackTop = top+{-# INLINABLE stackTop #-}++-- | Bottom of the stack+stackBottom :: StackIndex+stackBottom = 1+{-# INLINABLE stackBottom #-}

@@ -1,422 +0,0 @@-{-# LANGUAGE DeriveGeneric              #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE RankNTypes                 #-}-{-|-Module      : Foreign.Lua.Core.Types-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)--The core Lua types, including mappings of Lua types to Haskell.--}-module Foreign.Lua.Core.Types-  ( Lua (..)-  , LuaEnvironment (..)-  , ErrorConversion (..)-  , errorConversion-  , State (..)-  , Reader-  , liftLua-  , liftLua1-  , state-  , runWithConverter-  , unsafeRunWith-  , unsafeErrorConversion-  , GCCONTROL (..)-  , Type (..)-  , TypeCode (..)-  , fromType-  , toType-  , liftIO-  , CFunction-  , LuaBool (..)-  , false-  , true-  , fromLuaBool-  , toLuaBool-  , Integer (..)-  , Number (..)-  , StackIndex (..)-  , nthFromBottom-  , nthFromTop-  , stackTop-  , stackBottom-  , NumArgs (..)-  , NumResults (..)-  , RelationalOperator (..)-  , fromRelationalOperator-  , Status (..)-  , StatusCode (..)-  , toStatus-    -- * References-  , Reference (..)-  , fromReference-  , toReference-  ) where--#include "lua.h"--- required only for LUA_ERRFILE-#include "lauxlib.h"--import Prelude hiding (Integer, EQ, LT)--import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow)-import Control.Monad.Reader (ReaderT (..), MonadReader, MonadIO, asks, liftIO)-import Data.Int (#{type LUA_INTEGER})-import Foreign.C (CChar, CInt, CSize)-import Foreign.Ptr (FunPtr, Ptr)-import Foreign.Storable (Storable)-import GHC.Generics (Generic)---- | Define the ways in which exceptions and errors are handled.-data ErrorConversion = ErrorConversion-  { errorToException :: forall a . State -> IO a-    -- ^ Translate Lua errors to Haskell exceptions-  , addContextToException :: forall a . String -> Lua a -> Lua a-    -- ^ Add information on the current context to an exception.-  , alternative :: forall a . Lua a -> Lua a -> Lua a-    -- ^ Runs the second computation only if the first fails; returns-    -- the result of the first successful computation, if any.-  , exceptionToError :: Lua NumResults -> Lua NumResults-    -- ^ Translate Haskell exceptions to Lua errors-  }---- | Environment in which Lua computations are evaluated.-data LuaEnvironment = LuaEnvironment-  { luaEnvErrorConversion :: ErrorConversion-    -- ^ Functions for error and exception handling and conversion-  , luaEnvState :: State-    -- ^ Lua interpreter state-  }---- | A Lua computation. This is the base type used to run Lua programs of any--- kind. The Lua state is handled automatically, but can be retrieved via--- @'state'@.-newtype Lua a = Lua { unLua :: ReaderT LuaEnvironment IO a }-  deriving-    ( Applicative-    , Functor-    , Monad-    , MonadCatch-    , MonadIO-    , MonadMask-    , MonadReader LuaEnvironment-    , MonadThrow-    )---- | Turn a function of typ @Lua.State -> IO a@ into a monadic Lua operation.-liftLua :: (State -> IO a) -> Lua a-liftLua f = state >>= liftIO . f---- | Turn a function of typ @Lua.State -> a -> IO b@ into a monadic Lua operation.-liftLua1 :: (State -> a -> IO b) -> a -> Lua b-liftLua1 f x = liftLua $ \l -> f l x---- | Get the Lua state of this Lua computation.-state :: Lua State-state = asks luaEnvState---- | Get the error-to-exception function.-errorConversion :: Lua ErrorConversion-errorConversion = asks luaEnvErrorConversion---- | Run Lua computation with the given Lua state and error-to-exception--- converter. Any resulting exceptions are left unhandled.-runWithConverter :: ErrorConversion -> State -> Lua a -> IO a-runWithConverter e2e l s =-  runReaderT (unLua s) (LuaEnvironment e2e l)---- | Run the given operation, but crash if any Haskell exceptions occur.-unsafeRunWith :: State -> Lua a -> IO a-unsafeRunWith = runWithConverter unsafeErrorConversion---- | Unsafe @'ErrorConversion'@; no proper error handling is attempted,--- any error leads to a crash.-unsafeErrorConversion :: ErrorConversion-unsafeErrorConversion = ErrorConversion-  { errorToException = const (error "An unrecoverable Lua error occured.")-  , addContextToException = const id-  , alternative = const-  , exceptionToError = id-  }---- | An opaque structure that points to a thread and indirectly (through the--- thread) to the whole state of a Lua interpreter. The Lua library is fully--- reentrant: it has no global variables. All information about a state is--- accessible through this structure.------ Synonym for @lua_State *@. See <https://www.lua.org/manual/5.3/#lua_State lua_State>.-newtype State = State (Ptr ()) deriving (Eq, Generic)---- |  Type for C functions.------ In order to communicate properly with Lua, a C function must use the--- following protocol, which defines the way parameters and results are--- passed: a C function receives its arguments from Lua in its stack in--- direct order (the first argument is pushed first). So, when the--- function starts, @'Foreign.Lua.Core.Functions.gettop'@ returns the--- number of arguments received by the function. The first argument (if--- any) is at index 1 and its last argument is at index--- @'Foreign.Lua.Core.Functions.gettop'@. To return values to Lua, a C--- function just pushes them onto the stack, in direct order (the first--- result is pushed first), and returns the number of results. Any other--- value in the stack below the results will be properly discarded by--- Lua. Like a Lua function, a C function called by Lua can also return--- many results.------ See <https://www.lua.org/manual/5.3/manual.html#lua_CFunction lua_CFunction>.-type CFunction = FunPtr (State -> IO NumResults)---- | The reader function used by @'Foreign.Lua.Core.Functions.load'@.--- Every time it needs another piece of the chunk, lua_load calls the--- reader, passing along its data parameter. The reader must return a--- pointer to a block of memory with a new piece of the chunk and set--- size to the block size. The block must exist until the reader--- function is called again. To signal the end of the chunk, the reader--- must return @NULL@ or set size to zero. The reader function may--- return pieces of any size greater than zero.------ See <https://www.lua.org/manual/5.3/manual.html#lua_Reader lua_Reader>.-type Reader = FunPtr (State -> Ptr () -> Ptr CSize -> IO (Ptr CChar))---- |  The type of integers in Lua.------ By default this type is @'Int64'@, but that can be changed to different--- values in lua. (See @LUA_INT_TYPE@ in @luaconf.h@.)------ See <https://www.lua.org/manual/5.3/manual.html#lua_Integer lua_Integer>.-newtype Integer = Integer #{type LUA_INTEGER}-  deriving (Bounded, Enum, Eq, Integral, Num, Ord, Real, Show)---- |  The type of floats in Lua.------ By default this type is @'Double'@, but that can be changed in Lua to a--- single float or a long double. (See @LUA_FLOAT_TYPE@ in @luaconf.h@.)------ See <https://www.lua.org/manual/5.3/manual.html#lua_Number lua_Number>.-newtype Number = Number #{type LUA_NUMBER}-  deriving (Eq, Floating, Fractional, Num, Ord, Real, RealFloat, RealFrac, Show)-------- LuaBool------- | Boolean value returned by a Lua C API function. This is a @'CInt'@ and--- interpreted as @'False'@ iff the value is @0@, @'True'@ otherwise.-newtype LuaBool = LuaBool CInt-  deriving (Eq, Storable, Show)---- | Generic Lua representation of a value interpreted as being true.-true :: LuaBool-true = LuaBool 1---- | Lua representation of the value interpreted as false.-false :: LuaBool-false = LuaBool 0---- | Convert a @'LuaBool'@ to a Haskell @'Bool'@.-fromLuaBool :: LuaBool -> Bool-fromLuaBool (LuaBool 0) = False-fromLuaBool _           = True-{-# INLINABLE fromLuaBool #-}---- | Convert a Haskell @'Bool'@ to a @'LuaBool'@.-toLuaBool :: Bool -> LuaBool-toLuaBool True  = true-toLuaBool False = false-{-# INLINABLE toLuaBool #-}-------- * Type of Lua values------- | Enumeration used as type tag.--- See <https://www.lua.org/manual/5.3/manual.html#lua_type lua_type>.-data Type-  = TypeNone           -- ^ non-valid stack index-  | TypeNil            -- ^ type of lua's @nil@ value-  | TypeBoolean        -- ^ type of lua booleans-  | TypeLightUserdata  -- ^ type of light userdata-  | TypeNumber         -- ^ type of lua numbers. See @'Lua.Number'@-  | TypeString         -- ^ type of lua string values-  | TypeTable          -- ^ type of lua tables-  | TypeFunction       -- ^ type of functions, either normal or @'CFunction'@-  | TypeUserdata       -- ^ type of full user data-  | TypeThread         -- ^ type of lua threads-  deriving (Bounded, Eq, Ord, Show)---- | Integer code used to encode the type of a lua value.-newtype TypeCode = TypeCode { fromTypeCode :: CInt }-  deriving (Eq, Ord, Show)--instance Enum Type where-  fromEnum = fromIntegral . fromTypeCode . fromType-  toEnum = toType . TypeCode . fromIntegral---- | Convert a lua Type to a type code which can be passed to the C API.-fromType :: Type -> TypeCode-fromType tp = TypeCode $ case tp of-  TypeNone          -> #{const LUA_TNONE}-  TypeNil           -> #{const LUA_TNIL}-  TypeBoolean       -> #{const LUA_TBOOLEAN}-  TypeLightUserdata -> #{const LUA_TLIGHTUSERDATA}-  TypeNumber        -> #{const LUA_TNUMBER}-  TypeString        -> #{const LUA_TSTRING}-  TypeTable         -> #{const LUA_TTABLE}-  TypeFunction      -> #{const LUA_TFUNCTION}-  TypeUserdata      -> #{const LUA_TUSERDATA}-  TypeThread        -> #{const LUA_TTHREAD}---- | Convert numerical code to lua type.-toType :: TypeCode -> Type-toType (TypeCode c) = case c of-  #{const LUA_TNONE}          -> TypeNone-  #{const LUA_TNIL}           -> TypeNil-  #{const LUA_TBOOLEAN}       -> TypeBoolean-  #{const LUA_TLIGHTUSERDATA} -> TypeLightUserdata-  #{const LUA_TNUMBER}        -> TypeNumber-  #{const LUA_TSTRING}        -> TypeString-  #{const LUA_TTABLE}         -> TypeTable-  #{const LUA_TFUNCTION}      -> TypeFunction-  #{const LUA_TUSERDATA}      -> TypeUserdata-  #{const LUA_TTHREAD}        -> TypeThread-  _ -> error ("No Type corresponding to " ++ show c)------- * Relational Operator------- | Lua comparison operations.-data RelationalOperator-  = EQ -- ^ Correponds to lua's equality (==) operator.-  | LT -- ^ Correponds to lua's strictly-lesser-than (<) operator-  | LE -- ^ Correponds to lua's lesser-or-equal (<=) operator-  deriving (Eq, Ord, Show)---- | Convert relation operator to its C representation.-fromRelationalOperator :: RelationalOperator -> CInt-fromRelationalOperator EQ = #{const LUA_OPEQ}-fromRelationalOperator LT = #{const LUA_OPLT}-fromRelationalOperator LE = #{const LUA_OPLE}-{-# INLINABLE fromRelationalOperator #-}-------- * Status------- | Lua status values.-data Status-  = OK        -- ^ success-  | Yield     -- ^ yielding / suspended coroutine-  | ErrRun    -- ^ a runtime rror-  | ErrSyntax -- ^ syntax error during precompilation-  | ErrMem    -- ^ memory allocation (out-of-memory) error.-  | ErrErr    -- ^ error while running the message handler.-  | ErrGcmm   -- ^ error while running a @__gc@ metamethod.-  | ErrFile   -- ^ opening or reading a file failed.-  deriving (Eq, Show)---- | Convert C integer constant to @'Status'@.-toStatus :: StatusCode -> Status-toStatus (StatusCode c) = case c of-  #{const LUA_OK}        -> OK-  #{const LUA_YIELD}     -> Yield-  #{const LUA_ERRRUN}    -> ErrRun-  #{const LUA_ERRSYNTAX} -> ErrSyntax-  #{const LUA_ERRMEM}    -> ErrMem-  #{const LUA_ERRGCMM}   -> ErrGcmm-  #{const LUA_ERRERR}    -> ErrErr-  #{const LUA_ERRFILE}   -> ErrFile-  n -> error $ "Cannot convert (" ++ show n ++ ") to Status"-{-# INLINABLE toStatus #-}---- | Integer code used to signal the status of a thread or computation.--- See @'Status'@.-newtype StatusCode = StatusCode CInt deriving Eq-------- * Gargabe Collection Control------- | Enumeration used by @gc@ function.-data GCCONTROL-  = GCSTOP-  | GCRESTART-  | GCCOLLECT-  | GCCOUNT-  | GCCOUNTB-  | GCSTEP-  | GCSETPAUSE-  | GCSETSTEPMUL-  deriving (Enum, Eq, Ord, Show)---- | A stack index-newtype StackIndex = StackIndex { fromStackIndex :: CInt }-  deriving (Enum, Eq, Num, Ord, Show)---- | Stack index of the nth element from the top of the stack.-nthFromTop :: CInt -> StackIndex-nthFromTop n = StackIndex (-n)-{-# INLINABLE nthFromTop #-}---- | Stack index of the nth element from the bottom of the stack.-nthFromBottom :: CInt -> StackIndex-nthFromBottom = StackIndex-{-# INLINABLE nthFromBottom #-}---- | Top of the stack-stackTop :: StackIndex-stackTop = -1-{-# INLINABLE stackTop #-}---- | Bottom of the stack-stackBottom :: StackIndex-stackBottom = 1-{-# INLINABLE stackBottom #-}------- Number of arguments and return values------- | The number of arguments expected a function.-newtype NumArgs = NumArgs { fromNumArgs :: CInt }-  deriving (Eq, Num, Ord, Show)---- | The number of results returned by a function call.-newtype NumResults = NumResults { fromNumResults :: CInt }-  deriving (Eq, Num, Ord, Show)------- References------- | Value signaling that no reference was created.-refnil :: CInt-refnil = #{const LUA_REFNIL}---- | Reference to a stored value.-data Reference =-    Reference CInt -- ^ Reference to a stored value-  | RefNil         -- ^ Reference to a nil value-  deriving (Eq, Show)---- | Convert a reference to its C representation.-fromReference :: Reference -> CInt-fromReference = \case-  Reference x -> x-  RefNil      -> refnil---- | Create a reference from its C representation.-toReference :: CInt -> Reference-toReference x =-  if x == refnil-  then RefNil-  else Reference x

@@ -30,17 +30,17 @@   , registerHaskellFunction   ) where -import Data.ByteString (ByteString) import Foreign.C (CInt (..)) import Foreign.Lua.Core as Lua+import Foreign.Lua.Core.Types (liftLua)+import Foreign.Lua.Raw.Call (hslua_pushhsfunction) import Foreign.Lua.Types-import Foreign.Lua.Userdata ( ensureUserdataMetatable, pushAnyWithMetatable-                            , toAnyWithName )-import Foreign.Lua.Util (getglobal', popValue, raiseError)+import Foreign.Lua.Util (getglobal', popValue) import Foreign.Ptr (freeHaskellFunPtr) --- | Type of raw Haskell functions that can be made into 'CFunction's.-type PreCFunction = Lua.State -> IO NumResults+-- | Type of raw Haskell functions that can be made into+-- 'CFunction's.+type PreCFunction = State -> IO NumResults  -- | Haskell function that can be called from Lua. type HaskellFunction = Lua NumResults@@ -101,7 +101,7 @@   liftIO . mkWrapper . flip (Lua.runWithConverter e2e) . toHaskellFunction $ f  -- | Turn a @'PreCFunction'@ into an actual @'CFunction'@.-foreign import ccall "wrapper"+foreign import ccall unsafe "wrapper"   mkWrapper :: PreCFunction -> IO CFunction  -- | Free function pointer created with @newcfunction@.@@ -146,41 +146,13 @@ pushHaskellFunction :: ToHaskellFunction a => a -> Lua () pushHaskellFunction hsFn = do   errConv <- Lua.errorConversion-  pushPreCFunction . flip (runWithConverter errConv) $ toHaskellFunction hsFn-  -- Convert userdata object into a CFuntion.-  pushcclosure hslua_call_hs_ptr 1---- | Convert callable userdata at top of stack into a CFunction, translating--- errors to Lua errors.  Use with @'pushcclosure'@.-foreign import ccall "error-conversion.h &hslua_call_hs"-  hslua_call_hs_ptr :: CFunction--hsLuaFunctionName :: String-hsLuaFunctionName = "HsLuaFunction"+  preCFn <- return . flip (runWithConverter errConv) $ toHaskellFunction hsFn+  pushPreCFunction preCFn  -- | Converts a pre C function to a Lua function and pushes it to the stack. -- -- Pre C functions collect parameters from the stack and return -- a `CInt` that represents number of return values left on the stack. pushPreCFunction :: PreCFunction -> Lua ()-pushPreCFunction f =-  let pushMetatable = ensureUserdataMetatable hsLuaFunctionName $ do-        -- ensure the userdata will be callable-        pushcfunction hslua_call_wrapped_hs_fun_ptr-        setfield (-2) "__call"-  in pushAnyWithMetatable pushMetatable f---- | Call the Haskell function stored in the userdata. This function is exported--- as a C function and then re-imported in order to get a C function pointer.-hslua_call_wrapped_hs_fun :: Lua.State -> IO NumResults-hslua_call_wrapped_hs_fun l = do-  mbFn <- unsafeRunWith l (toAnyWithName stackBottom hsLuaFunctionName-                           <* remove stackBottom)-  case mbFn of-    Just fn -> fn l-    Nothing -> unsafeRunWith l-               (raiseError ("Could not call function" :: ByteString))--foreign export ccall hslua_call_wrapped_hs_fun :: PreCFunction-foreign import ccall "&hslua_call_wrapped_hs_fun"-  hslua_call_wrapped_hs_fun_ptr :: CFunction+pushPreCFunction preCFn = liftLua $ \l ->+  hslua_pushhsfunction l preCFn

@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} {-| Module      : Foreign.Lua.Module Copyright   : © 2019-2020 Albert Krewinkel@@ -14,24 +15,41 @@   , addfield   , addfunction   , create+    -- * Module+  , Module (..)+  , Field (..)+  , registerModule+  , preloadModule+  , pushModule+    -- * Documentation+  , render   ) where -import Control.Monad (unless)+import Control.Monad (unless, forM_)+import Data.Text (Text)+import Foreign.Lua.Call (HaskellFunction) import Foreign.Lua.Core+import Foreign.Lua.Push (pushText) import Foreign.Lua.Types (Pushable, push)-import Foreign.Lua.FunctionCalling (ToHaskellFunction, pushHaskellFunction)+import Foreign.Lua.FunctionCalling+  ( ToHaskellFunction+  , pushHaskellFunction+  )+import qualified Data.Text as T+import qualified Foreign.Lua.Call as Call --- | Load a module, defined by a Haskell action, under the given name.+-- | 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.+-- 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.+-- 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. requirehs :: String -> Lua () -> Lua ()@@ -52,8 +70,8 @@    remove (nthFromTop 2)  -- remove table of loaded modules --- | Registers a preloading function. Takes an module name and the Lua--- operation which produces the package.+-- | Registers a preloading function. Takes an module name and the+-- Lua operation which produces the package. preloadhs :: String -> Lua NumResults -> Lua () preloadhs name pushMod = do   getfield registryindex preloadTableRegistryField@@ -61,15 +79,16 @@   setfield (nthFromTop 2) name   pop 1 --- | Add a string-indexed field to the table at the top of the stack.+-- | Add a string-indexed field to the table at the top of the+-- stack. addfield :: Pushable a => String -> a -> Lua () addfield name value = do   push name   push value   rawset (nthFromTop 3) --- | Attach a function to the table at the top of the stack, using the--- given name.+-- | Attach a function to the table at the top of the stack, using+-- the given name. addfunction :: ToHaskellFunction a => String -> a -> Lua () addfunction name fn = do   push name@@ -79,3 +98,86 @@ -- | Create a new module (i.e., a Lua table). create :: Lua () create = newtable++-- | Named and documented Lua module.+data Module = Module+  { moduleName :: Text+  , moduleDescription :: Text+  , moduleFields :: [Field]+  , moduleFunctions :: [(Text, HaskellFunction)]+  }++-- | Self-documenting module field+data Field = Field+  { fieldName :: Text+  , fieldDescription :: Text+  , fieldPushValue :: Lua ()+  }+++-- | Registers a 'Module'; leaves a copy of the module table on+-- the stack.+registerModule :: Module -> Lua ()+registerModule mdl =+  requirehs (T.unpack $ moduleName mdl) (pushModule mdl)++-- | Preload self-documenting module.+preloadModule :: Module -> Lua ()+preloadModule mdl =+  preloadhs (T.unpack $ moduleName mdl) $ do+    pushModule mdl+    return (NumResults 1)++pushModule :: Module -> Lua ()+pushModule mdl = do+  create+  forM_ (moduleFunctions mdl) $ \(name, fn) -> do+    pushText name+    Call.pushHaskellFunction fn+    rawset (nthFromTop 3)++-- | Renders module documentation as Markdown.+render :: Module -> Text+render mdl =+  let fields = moduleFields mdl+  in T.unlines+     [ "# " <> moduleName mdl+     , ""+     , moduleDescription mdl+     , if null (moduleFields mdl) then "" else renderFields fields+     , "## Functions"+     , ""+     ]+     <> T.intercalate "\n"+        (map (uncurry renderFunctionDoc) (moduleFunctions mdl))++-- | Renders documentation of a function.+renderFunctionDoc :: Text             -- ^ name+                  -> HaskellFunction  -- ^ function+                  -> Text             -- ^ function docs+renderFunctionDoc name fn =+  case Call.functionDoc fn of+    Nothing -> ""+    Just fnDoc -> T.intercalate "\n"+      [ "### " <> name <> " (" <> renderFunctionParams fnDoc <> ")"+      , ""+      , Call.render fnDoc+      ]++renderFunctionParams :: Call.FunctionDoc -> Text+renderFunctionParams fd =+    T.intercalate ", "+  . map Call.parameterName+  $ Call.parameterDocs fd++-- | Render documentation for fields as Markdown.+renderFields :: [Field] -> Text+renderFields fs =+  if null fs+  then mempty+  else T.unlines $ map renderField fs++-- | Renders documentation for a single field.+renderField :: Field -> Text+renderField f =+  "### " <> fieldName f <> "\n\n" <> fieldDescription f <> "\n"

@@ -14,6 +14,8 @@   , PeekError (..)   , errorMsg   , force+  , formatPeekError+  , pushMsg   , toPeeker   -- * Primitives   , peekBool@@ -29,6 +31,8 @@   , peekList   , peekMap   , peekSet+  -- * Combinators+  , optional   ) where  import Control.Applicative ((<|>))@@ -240,3 +244,17 @@     fmap (retrieving "Set" .           second (Set.fromList . map fst . filter snd))   . peekKeyValuePairs elementPeeker peekBool++--+-- Combinators+--++-- | Makes a result optional. Returns 'Nothing' if the Lua value+-- is @nil@; otherwise applies the peeker and returns its result.+optional :: Peeker a -- ^ peeker+         -> Peeker (Maybe a)+optional peeker idx = do+  noValue <- Lua.isnoneornil idx+  if noValue+    then return $ Right Nothing+    else fmap Just <$> peeker idx

@@ -0,0 +1,135 @@+{-# LANGUAGE CPP #-}+{-|+Module      : Foreign.Lua.Raw.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)++Raw bindings to functions and constants of the auxiliary library.+-}+module Foreign.Lua.Raw.Auxiliary+  ( c_loaded_table+  , c_preload_table+  , hsluaL_newstate+  , hsluaL_tolstring+  , luaL_getmetafield+  , luaL_getmetatable+  , luaL_loadbuffer+  , luaL_newmetatable+  , luaL_ref+  , luaL_testudata+  , luaL_traceback+  , luaL_unref+    -- * Registry fields+  , loadedTableRegistryField+  , preloadTableRegistryField+    -- * References+  , Reference (..)+  , fromReference+  , toReference+  ) where++import Foreign.C (CChar, CInt (CInt), CSize (CSize), CString)+import Foreign.Lua.Raw.Types (StackIndex)+import Foreign.Ptr+import qualified Foreign.Lua.Raw.Types as Lua++#ifndef HARDCODE_REG_KEYS+import System.IO.Unsafe (unsafePerformIO)+import qualified Foreign.C as C+#endif++#ifdef ALLOW_UNSAFE_GC+#define SAFTY unsafe+#else+#define SAFTY safe+#endif++-- * The Auxiliary Library++-- | Key, in the registry, for table of loaded modules.+loadedTableRegistryField :: String+#ifdef HARDCODE_REG_KEYS+loadedTableRegistryField = "_LOADED"+#else+loadedTableRegistryField = unsafePerformIO (C.peekCString c_loaded_table)+{-# NOINLINE loadedTableRegistryField #-}++foreign import capi unsafe "lauxlib.h value LUA_LOADED_TABLE"+  c_loaded_table :: CString+#endif++-- | Key, in the registry, for table of preloaded loaders.+preloadTableRegistryField :: String+#ifdef HARDCODE_REG_KEYS+preloadTableRegistryField = "_PRELOAD"+#else+preloadTableRegistryField = unsafePerformIO (C.peekCString c_preload_table)+{-# NOINLINE preloadTableRegistryField #-}++foreign import capi unsafe "lauxlib.h value LUA_PRELOAD_TABLE"+  c_preload_table :: CString+#endif++foreign import capi SAFTY "lauxlib.h luaL_getmetafield"+  luaL_getmetafield :: Lua.State -> StackIndex -> CString -> IO Lua.TypeCode++foreign import capi SAFTY "lauxlib.h luaL_getmetatable"+  luaL_getmetatable :: Lua.State -> CString -> IO Lua.TypeCode++foreign import capi SAFTY "lauxlib.h luaL_loadbuffer"+  luaL_loadbuffer :: Lua.State -> Ptr CChar -> CSize -> CString+                  -> IO Lua.StatusCode++foreign import ccall SAFTY "lauxlib.h luaL_newmetatable"+  luaL_newmetatable :: Lua.State -> CString -> IO Lua.LuaBool++foreign import ccall unsafe "lauxlib.h hsluaL_newstate"+  hsluaL_newstate :: IO Lua.State++foreign import ccall SAFTY "lauxlib.h luaL_ref"+  luaL_ref :: Lua.State -> StackIndex -> IO CInt++foreign import ccall safe "hslua.h hsluaL_tolstring"+  hsluaL_tolstring :: Lua.State -> StackIndex -> Ptr CSize -> IO (Ptr CChar)++foreign import capi SAFTY "lauxlib.h luaL_traceback"+  luaL_traceback :: Lua.State -> Lua.State -> CString -> CInt -> IO ()++foreign import ccall SAFTY "lauxlib.h luaL_unref"+  luaL_unref :: Lua.State -> StackIndex -> CInt -> IO ()++-- | See+-- <https://www.lua.org/manual/5.3/manual.html#luaL_testudata luaL_testudata>+foreign import capi SAFTY "lauxlib.h luaL_testudata"+  luaL_testudata :: Lua.State -> StackIndex -> CString -> IO (Ptr ())++--+-- References+--++-- | Reference to a stored value.+data Reference =+    Reference CInt -- ^ Reference to a stored value+  | RefNil         -- ^ Reference to a nil value+  deriving (Eq, Show)++foreign import capi SAFTY "lauxlib.h value LUA_REFNIL"+  refnil :: CInt++-- | Convert a reference to its C representation.+fromReference :: Reference -> CInt+fromReference = \case+  Reference x -> x+  RefNil      -> refnil++-- | Create a reference from its C representation.+toReference :: CInt -> Reference+toReference x =+  if x == refnil+  then RefNil+  else Reference x

@@ -0,0 +1,65 @@+{-# LANGUAGE CPP #-}+{-|+Module      : Foreign.Lua.Raw.Call+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)++Raw bindings to function call helpers.+-}+module Foreign.Lua.Raw.Call+  ( HsFunction+  , hslua_newhsfunction+  , hslua_pushhsfunction+  ) where++import Foreign.C (CInt (CInt))+import Foreign.Ptr (Ptr, castPtr, nullPtr)+import Foreign.StablePtr (StablePtr, deRefStablePtr, newStablePtr)+import Foreign.Storable (peek)+import Foreign.Lua.Raw.Types+  ( NumResults (NumResults)+  , State (State)+  )++#ifdef ALLOW_UNSAFE_GC+#define SAFTY unsafe+#else+#define SAFTY safe+#endif++-- | Type of raw Haskell functions that can be made into+-- 'CFunction's.+type HsFunction = State -> IO NumResults++-- | Retrieve the pointer to a Haskell function from the wrapping+-- userdata object.+foreign import ccall SAFTY "hslua.h hslua_hs_fun_ptr"+  hslua_hs_fun_ptr :: State -> IO (Ptr ())++-- | Pushes a new C function created from an 'HsFunction'.+foreign import ccall SAFTY "hslua.h hslua_newhsfunction"+  hslua_newhsfunction :: State -> StablePtr a -> IO ()++hslua_pushhsfunction :: State -> HsFunction -> IO ()+hslua_pushhsfunction l preCFn =+  newStablePtr preCFn >>= hslua_newhsfunction l+{-# INLINABLE hslua_pushhsfunction #-}++-- | Call the Haskell function stored in the userdata. This+-- function is exported as a C function, as the C code uses it as+-- the @__call@ value of the wrapping userdata metatable.+hslua_call_wrapped_hs_fun :: HsFunction+hslua_call_wrapped_hs_fun l = do+  udPtr <- hslua_hs_fun_ptr l+  if udPtr == nullPtr+    then error "Cannot call function; corrupted Lua object!"+    else do+      fn <- peek (castPtr udPtr) >>= deRefStablePtr+      fn l++foreign export ccall hslua_call_wrapped_hs_fun :: HsFunction

@@ -0,0 +1,39 @@+{-|+Module      : Foreign.Lua.Raw.Constants+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 : ForeignFunctionInterface++Lua constants+-}+module Foreign.Lua.Raw.Constants+  ( multret+  , registryindex+  , refnil+  , noref+  ) where++import Foreign.C (CInt (..))+import Foreign.Lua.Raw.Types++-- | Alias for C constant @LUA_MULTRET@. See+-- <https://www.lua.org/manual/5.3/#lua_call lua_call>.+foreign import capi unsafe "lua.h value LUA_MULTRET"+  multret :: NumResults++-- | Alias for C constant @LUA_REGISTRYINDEX@. See+-- <https://www.lua.org/manual/5.3/#3.5 Lua registry>.+foreign import capi unsafe "lua.h value LUA_REGISTRYINDEX"+  registryindex :: StackIndex++-- | Value signaling that no reference was created.+foreign import capi unsafe "lauxlib.h value LUA_REFNIL"+  refnil :: Int++-- | Value signaling that no reference was found.+foreign import capi unsafe "lauxlib.h value LUA_NOREF"+  noref :: Int

@@ -0,0 +1,40 @@+{-|+Module      : Foreign.Lua.Raw.Error+Copyright   : © 2017-2020 Albert Krewinkel+License     : MIT+Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de>+Stability   : beta+Portability : portable++Lua exceptions and exception handling.+-}+module Foreign.Lua.Raw.Error+  ( -- * Passing Lua errors to Haskell+    errorMessage+  ) where++import Data.ByteString (ByteString)+import Foreign.Lua.Raw.Auxiliary (hsluaL_tolstring)+import Foreign.Lua.Raw.Functions (lua_pop)+import Foreign.Marshal.Alloc (alloca)+import Foreign.Ptr (nullPtr)++import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as Char8+import qualified Foreign.Storable as Storable+import qualified Foreign.Lua.Raw.Types as Lua++-- | Retrieve and pop the top object as an error message. This is very similar+-- to tostring', but ensures that we don't recurse if getting the message+-- failed.+errorMessage :: Lua.State -> IO ByteString+errorMessage l = alloca $ \lenPtr -> do+  cstr <- hsluaL_tolstring l (-1) lenPtr+  if cstr == nullPtr+    then return $ Char8.pack ("An error occurred, but the error object " +++                              "cannot be converted into a string.")+    else do+      cstrLen <- Storable.peek lenPtr+      msg <- B.packCStringLen (cstr, fromIntegral cstrLen)+      lua_pop l 2+      return msg

@@ -0,0 +1,393 @@+{-# LANGUAGE CPP #-}+{-|+Module      : Foreign.Lua.Raw.Functions+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 : ForeignFunctionInterface, CPP++Haskell bindings to Lua C API functions.+-}+module Foreign.Lua.Raw.Functions where++import Foreign.C+import Foreign.Lua.Raw.Types as Lua+import Foreign.Ptr++#ifdef ALLOW_UNSAFE_GC+#define SAFTY unsafe+#else+#define SAFTY safe+#endif++-- TODO: lua_getallocf, lua_setallocf+-- TODO: Debugger functions++-- Some of the Lua functions may call a Haskell function, and trigger+-- garbage collection, rescheduling etc. This means we must declare these+-- functions as 'safe'.+++--------------------------------------------------------------------------------+-- * State manipulation++-- lua_newstate is currently not supported.++-- | See <https://www.lua.org/manual/5.3/manual.html#lua_close lua_close>+foreign import ccall safe "lua.h lua_close"+  lua_close :: Lua.State -> IO ()++-- lua_newthread is currently not supported.+++--------------------------------------------------------------------------------+-- * Basic stack manipulation++-- | See <https://www.lua.org/manual/5.3/manual.html#lua_absindex lua_absindex>+foreign import ccall SAFTY "lua.h lua_absindex"+  lua_absindex :: Lua.State -> StackIndex -> IO StackIndex++-- | See <https://www.lua.org/manual/5.3/manual.html#lua_gettop lua_gettop>+foreign import ccall SAFTY "lua.h lua_gettop"+  lua_gettop :: Lua.State -> IO StackIndex++-- | See <https://www.lua.org/manual/5.3/manual.html#lua_settop lua_settop>+foreign import ccall SAFTY "lua.h lua_settop"+  lua_settop :: Lua.State -> StackIndex -> IO ()++-- | See <https://www.lua.org/manual/5.3/manual.html#lua_pushvalue lua_pushvalue>+foreign import ccall SAFTY "lua.h lua_pushvalue"+  lua_pushvalue :: Lua.State -> StackIndex -> IO ()++-- | See <https://www.lua.org/manual/5.3/manual.html#lua_pop lua_pop>+foreign import capi SAFTY "lua.h lua_pop"+  lua_pop :: Lua.State -> StackIndex -> IO ()++-- | See <https://www.lua.org/manual/5.3/manual.html#lua_copy lua_copy>+foreign import ccall SAFTY "lua.h lua_copy"+  lua_copy :: Lua.State -> StackIndex -> StackIndex -> IO ()++-- | See <https://www.lua.org/manual/5.2/manual.html#lua_remove lua_remove>+foreign import capi SAFTY "lua.h lua_remove"+  lua_remove :: Lua.State -> StackIndex -> IO ()++-- | See <https://www.lua.org/manual/5.2/manual.html#lua_insert lua_insert>+foreign import capi SAFTY "lua.h lua_insert"+  lua_insert :: Lua.State -> StackIndex -> IO ()++-- | See <https://www.lua.org/manual/5.2/manual.html#lua_replace lua_replace>+foreign import capi SAFTY "lua.h lua_replace"+  lua_replace :: Lua.State -> StackIndex -> IO ()++-- | See <https://www.lua.org/manual/5.3/manual.html#lua_checkstack lua_checkstack>+foreign import capi SAFTY "lua.h lua_checkstack"+  lua_checkstack :: Lua.State -> CInt -> IO LuaBool++-- lua_xmove is currently not supported.+++--------------------------------------------------------------------------------+-- * Stack access functions++-- | See <https://www.lua.org/manual/5.3/manual.html#lua_isnumber lua_isnumber>+foreign import ccall SAFTY "lua.h lua_isnumber"+  lua_isnumber :: Lua.State -> StackIndex -> IO LuaBool++-- | See <https://www.lua.org/manual/5.3/manual.html#lua_isinteger lua_isinteger>+foreign import ccall SAFTY "lua.h lua_isinteger"+  lua_isinteger :: Lua.State -> StackIndex -> IO LuaBool++-- | See <https://www.lua.org/manual/5.3/manual.html#lua_isstring lua_isstring>+foreign import ccall SAFTY "lua.h lua_isstring"+  lua_isstring :: Lua.State -> StackIndex -> IO LuaBool++-- | See <https://www.lua.org/manual/5.3/manual.html#lua_iscfunction lua_iscfunction>+foreign import ccall SAFTY "lua.h lua_iscfunction"+  lua_iscfunction :: Lua.State -> StackIndex -> IO LuaBool++-- | See <https://www.lua.org/manual/5.3/manual.html#lua_isuserdata lua_isuserdata>+foreign import ccall SAFTY "lua.h lua_isuserdata"+  lua_isuserdata :: Lua.State -> StackIndex -> IO LuaBool++-- | See <https://www.lua.org/manual/5.3/manual.html#lua_type lua_type>+foreign import ccall SAFTY "lua.h lua_type"+  lua_type :: Lua.State -> StackIndex -> IO TypeCode++-- | See <https://www.lua.org/manual/5.3/manual.html#lua_typename lua_typename>+foreign import ccall SAFTY "lua.h lua_typename"+  lua_typename :: Lua.State -> TypeCode -> IO CString++-- lua_compare is unsafe (might cause a longjmp), use hslua_compare instead.++-- | Wrapper around <https://lua.org/manual/5.3/manual.html#lua_compare \+-- @lua_compare@> which catches any @longjmp@s.+foreign import capi safe "hslua.h hslua_compare"+  hslua_compare :: Lua.State+                -> StackIndex -> StackIndex -> CInt+                -> Ptr StatusCode -> IO LuaBool++-- | See <https://www.lua.org/manual/5.3/manual.html#lua_rawequal lua_rawequal>+foreign import ccall SAFTY "lua.h lua_rawequal"+  lua_rawequal :: Lua.State -> StackIndex -> StackIndex -> IO LuaBool++--+-- Type coercion+--+-- | See <https://www.lua.org/manual/5.3/manual.html#lua_toboolean lua_toboolean>+foreign import capi SAFTY "lua.h lua_toboolean"+  lua_toboolean :: Lua.State -> StackIndex -> IO LuaBool++-- | See <https://www.lua.org/manual/5.3/manual.html#lua_tocfunction lua_tocfunction>+foreign import ccall SAFTY "lua.h lua_tocfunction"+  lua_tocfunction :: Lua.State -> StackIndex -> IO CFunction++-- | See <https://www.lua.org/manual/5.3/manual.html#lua_tointegerx lua_tointegerx>+foreign import ccall SAFTY "lua.h lua_tointegerx"+  lua_tointegerx :: Lua.State -> StackIndex -> Ptr LuaBool -> IO Lua.Integer++-- | See <https://www.lua.org/manual/5.3/manual.html#lua_tonumberx lua_tonumberx>+foreign import ccall SAFTY "lua.h lua_tonumberx"+  lua_tonumberx :: Lua.State -> StackIndex -> Ptr LuaBool -> IO Lua.Number++-- | See <https://www.lua.org/manual/5.3/manual.html#lua_tolstring lua_tolstring>+foreign import ccall SAFTY "lua.h lua_tolstring"+  lua_tolstring :: Lua.State -> StackIndex -> Ptr CSize -> IO (Ptr CChar)++-- | See <https://www.lua.org/manual/5.3/manual.html#lua_topointer lua_topointer>+foreign import ccall SAFTY "lua.h lua_topointer"+  lua_topointer :: Lua.State -> StackIndex -> IO (Ptr ())++-- | See <https://www.lua.org/manual/5.3/manual.html#lua_tothread lua_tothread>+foreign import ccall SAFTY "lua.h lua_tothread"+  lua_tothread :: Lua.State -> StackIndex -> IO Lua.State++-- | See <https://www.lua.org/manual/5.3/manual.html#lua_touserdata lua_touserdata>+foreign import ccall SAFTY "lua.h lua_touserdata"+  lua_touserdata :: Lua.State -> StackIndex -> IO (Ptr a)+++--+-- Object size+--++-- | See <https://www.lua.org/manual/5.3/manual.html#lua_rawlen lua_rawlen>+foreign import ccall SAFTY "lua.h lua_rawlen"+  lua_rawlen :: Lua.State -> StackIndex -> IO CSize+++--------------------------------------------------------------------------------+-- * Push functions++-- | See <https://www.lua.org/manual/5.3/manual.html#lua_pushnil lua_pushnil>+foreign import ccall SAFTY "lua.h lua_pushnil"+  lua_pushnil :: Lua.State -> IO ()++-- | See <https://www.lua.org/manual/5.3/manual.html#lua_pushnumber lua_pushnumber>+foreign import ccall SAFTY "lua.h lua_pushnumber"+  lua_pushnumber :: Lua.State -> Lua.Number -> IO ()++-- | See <https://www.lua.org/manual/5.3/manual.html#lua_pushinteger lua_pushinteger>+foreign import ccall SAFTY "lua.h lua_pushinteger"+  lua_pushinteger :: Lua.State -> Lua.Integer -> IO ()++-- | See <https://www.lua.org/manual/5.3/manual.html#lua_pushlstring lua_pushlstring>+foreign import ccall SAFTY "lua.h lua_pushlstring"+  lua_pushlstring :: Lua.State -> Ptr CChar -> CSize -> IO ()++-- lua_pushstring is currently not supported. It's difficult to use in a haskell+-- context.++-- | See <https://www.lua.org/manual/5.3/manual.html#lua_pushcclosure lua_pushcclosure>+foreign import ccall SAFTY "lua.h lua_pushcclosure"+  lua_pushcclosure :: Lua.State -> CFunction -> NumArgs -> IO ()++-- | See <https://www.lua.org/manual/5.3/manual.html#lua_pushboolean lua_pushboolean>+foreign import ccall SAFTY "lua.h lua_pushboolean"+  lua_pushboolean :: Lua.State -> LuaBool -> IO ()++-- | See <https://www.lua.org/manual/5.3/manual.html#lua_pushlightuserdata lua_pushlightuserdata>+foreign import ccall SAFTY "lua.h lua_pushlightuserdata"+  lua_pushlightuserdata :: Lua.State -> Ptr a -> IO ()++-- | See <https://www.lua.org/manual/5.3/manual.html#lua_pushthread lua_pushthread>+foreign import ccall SAFTY "lua.h lua_pushthread"+  lua_pushthread :: Lua.State -> IO CInt+++--------------------------------------------------------------------------------+-- * Get functions++-- + lua_gettable is unsafe, use hslua_gettable instead.+-- + lua_getglobal is unsafe, use hslua_getglobal instead.+-- + lua_getfield is unsafe, we build something equivallent using pushlstring and+--   gettable.++-- | Wrapper around <https://lua.org/manual/5.3/manual.html#lua_gettable \+-- @lua_gettable@> which catches any @longjmp@s.+foreign import ccall safe "hslua.h hslua_gettable"+  hslua_gettable :: Lua.State -> StackIndex -> Ptr StatusCode -> IO ()++-- | See <https://www.lua.org/manual/5.3/manual.html#lua_rawget lua_rawget>+foreign import ccall SAFTY "lua.h lua_rawget"+  lua_rawget :: Lua.State -> StackIndex -> IO ()++-- | See <https://www.lua.org/manual/5.3/manual.html#lua_rawgeti lua_rawgeti>+foreign import ccall SAFTY "lua.h lua_rawgeti"+  lua_rawgeti :: Lua.State -> StackIndex -> Lua.Integer -> IO ()++-- | See <https://www.lua.org/manual/5.3/manual.html#lua_createtable lua_createtable>+foreign import ccall SAFTY "lua.h lua_createtable"+  lua_createtable :: Lua.State -> CInt -> CInt -> IO ()++-- | See <https://www.lua.org/manual/5.3/manual.html#lua_newuserdata lua_newuserdata>+foreign import ccall SAFTY "lua.h lua_newuserdata"+  lua_newuserdata :: Lua.State -> CSize -> IO (Ptr ())++-- | See <https://www.lua.org/manual/5.3/manual.html#lua_getmetatable lua_getmetatable>+foreign import ccall SAFTY "lua.h lua_getmetatable"+  lua_getmetatable :: Lua.State -> StackIndex -> IO LuaBool++-- | Wrapper around <https://lua.org/manual/5.3/manual.html#lua_getglobal \+-- @lua_getglobal@> which catches any @longjmp@s.+foreign import ccall safe "hslua.h hslua_getglobal"+  hslua_getglobal :: Lua.State -> CString -> CSize -> Ptr StatusCode -> IO ()+++--------------------------------------------------------------------------------+-- * Set functions++-- lua_settable is unsafe, use hslua_settable instead.+-- lua_setfield is unsafe, use hslua_setfield instead.+-- lua_setglobal is unsafe, use hslua_setglobal instead.+-- lua_setfenv (5.1 only) is not supported.++-- | Wrapper around <https://lua.org/manual/5.3/manual.html#lua_settable \+-- @lua_settable@> which catches any @longjmp@s.+foreign import ccall safe "hslua.h hslua_settable"+  hslua_settable :: Lua.State -> StackIndex -> Ptr StatusCode -> IO ()++-- | See <https://www.lua.org/manual/5.3/manual.html#lua_rawset lua_rawset>+foreign import ccall SAFTY "lua.h lua_rawset"+  lua_rawset :: Lua.State -> StackIndex -> IO ()++-- | See <https://www.lua.org/manual/5.3/manual.html#lua_rawseti lua_rawseti>+foreign import ccall SAFTY "lua.h lua_rawseti"+  lua_rawseti :: Lua.State -> StackIndex -> Lua.Integer -> IO ()++-- | See <https://www.lua.org/manual/5.3/manual.html#lua_setmetatable lua_setmetatable>+foreign import ccall SAFTY "lua.h lua_setmetatable"+  lua_setmetatable :: Lua.State -> StackIndex -> IO ()++-- | Wrapper around <https://lua.org/manual/5.3/manual.html#lua_setglobal \+-- @lua_setglobal@> which catches any @longjmp@s.+foreign import ccall safe "hslua.h hslua_setglobal"+  hslua_setglobal :: Lua.State -> CString -> CSize -> Ptr StatusCode -> IO ()+++--------------------------------------------------------------------------------+-- * \'load\' and \'call\' functions (load and run Lua code)++-- lua_call is inherently unsafe, we do not support it.++-- | See <https://www.lua.org/manual/5.1/manual.html#lua_pcall lua_pcall>+foreign import capi safe "lua.h lua_pcall"+  lua_pcall :: Lua.State -> NumArgs -> NumResults -> StackIndex+            -> IO StatusCode++-- | See <https://www.lua.org/manual/5.3/manual.html#lua_load lua_load>+foreign import ccall safe "lua.h lua_load"+  lua_load :: Lua.State -> Lua.Reader -> Ptr () -> CString -> CString+           -> IO StatusCode++-- currently unsupported:+-- lua_dump+++------------------------------------------------------------------------------+-- * Coroutine functions++-- lua_yield / lua_yieldk and lua_resume are currently not supported.++-- | See <https://www.lua.org/manual/5.3/manual.html#lua_status lua_status>+foreign import ccall SAFTY "lua.h lua_status"+  lua_status :: Lua.State -> IO StatusCode+++------------------------------------------------------------------------------+-- * Garbage-collection functions and options++-- | See <https://www.lua.org/manual/5.3/manual.html#lua_gc lua_gc>+foreign import ccall safe "lua.h lua_gc"+  lua_gc :: Lua.State -> CInt -> CInt -> IO CInt+++------------------------------------------------------------------------------+-- * Miscellaneous functions++-- lua_error is unsafe, use hslua_error instead.+-- lua_next is unsafe, use hslua_next instead.+-- lua_concat is unsafe (may trigger a longjmp), use hslua_concat instead.++-- | Replacement for <https://lua.org/manual/5.3/manual.html#lua_error \+-- @lua_error@>; it uses the HsLua error signaling convention instead of raw+-- @longjmp@.+foreign import ccall SAFTY "hslua.h hslua_error"+  hslua_error :: Lua.State -> IO NumResults++-- | Wrapper around <https://lua.org/manual/5.3/manual.html#lua_next \+-- @lua_next@> which catches any @longjmp@s.+foreign import ccall safe "hslua.h hslua_next"+  hslua_next :: Lua.State -> StackIndex -> Ptr StatusCode -> IO LuaBool++-- | Wrapper around <https://lua.org/manual/5.3/manual.html#lua_concat \+-- @lua_concat@> which catches any @longjmp@s.+foreign import ccall safe "hslua.h hslua_concat"+  hslua_concat :: Lua.State -> NumArgs -> Ptr StatusCode -> IO ()++-- | See <https://www.lua.org/manual/5.3/manual.html#lua_pushglobaltable \+-- lua_pushglobaltable>+foreign import capi SAFTY "lua.h lua_pushglobaltable"+  lua_pushglobaltable :: Lua.State -> IO ()+++------------------------------------------------------------------------------+-- * Lua Libraries++-- | See <https://www.lua.org/manual/5.3/manual.html#luaL_openlibs luaL_openlibs>+foreign import ccall unsafe "lualib.h luaL_openlibs"+  luaL_openlibs :: Lua.State -> IO ()++-- | Point to function opening the base library.+foreign import ccall unsafe "lualib.h &luaopen_base"+  lua_open_base_ptr :: CFunction++-- | Point to function opening the table library.+foreign import ccall unsafe "lualib.h &luaopen_table"+  lua_open_table_ptr :: CFunction++-- | Point to function opening the io library.+foreign import ccall unsafe "lualib.h &luaopen_io"+  lua_open_io_ptr :: CFunction++-- | Point to function opening the os library.+foreign import ccall unsafe "lualib.h &luaopen_os"+  lua_open_os_ptr :: CFunction++-- | Point to function opening the string library.+foreign import ccall unsafe "lualib.h &luaopen_string"+  lua_open_string_ptr :: CFunction++-- | Point to function opening the math library.+foreign import ccall unsafe "lualib.h &luaopen_math"+  lua_open_math_ptr :: CFunction++-- | Point to function opening the debug library.+foreign import ccall unsafe "lualib.h &luaopen_debug"+  lua_open_debug_ptr :: CFunction++-- | Point to function opening the package library.+foreign import ccall unsafe "lualib.h &luaopen_package"+  lua_open_package_ptr :: CFunction

@@ -0,0 +1,281 @@+{-# LANGUAGE DeriveGeneric              #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-|+Module      : Foreign.Lua.Raw.Types+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)++The core Lua types, including mappings of Lua types to Haskell.+-}+module Foreign.Lua.Raw.Types+  ( State (..)+  , Reader+  , GCCONTROL (..)+  , Type (..)+  , TypeCode (..)+  , fromType+  , toType+  , CFunction+  , LuaBool (..)+  , false+  , true+  , fromLuaBool+  , toLuaBool+  , Integer (..)+  , Number (..)+  , StackIndex (..)+  , NumArgs (..)+  , NumResults (..)+  , RelationalOperator (..)+  , fromRelationalOperator+  , Status (..)+  , StatusCode (..)+  , toStatus+  ) where++#include "lua.h"+-- required only for LUA_ERRFILE+#include "lauxlib.h"++import Prelude hiding (Integer, EQ, LT)++import Data.Int (#{type LUA_INTEGER})+import Foreign.C (CChar, CInt, CSize)+import Foreign.Ptr (FunPtr, Ptr)+import Foreign.Storable (Storable)+import GHC.Generics (Generic)++-- | An opaque structure that points to a thread and indirectly (through the+-- thread) to the whole state of a Lua interpreter. The Lua library is fully+-- reentrant: it has no global variables. All information about a state is+-- accessible through this structure.+--+-- Synonym for @lua_State *@. See <https://www.lua.org/manual/5.3/#lua_State lua_State>.+newtype State = State (Ptr ()) deriving (Eq, Generic)++-- |  Type for C functions.+--+-- In order to communicate properly with Lua, a C function must use the+-- following protocol, which defines the way parameters and results are+-- passed: a C function receives its arguments from Lua in its stack in+-- direct order (the first argument is pushed first). So, when the+-- function starts, @'Foreign.Lua.Core.Functions.gettop'@ returns the+-- number of arguments received by the function. The first argument (if+-- any) is at index 1 and its last argument is at index+-- @'Foreign.Lua.Core.Functions.gettop'@. To return values to Lua, a C+-- function just pushes them onto the stack, in direct order (the first+-- result is pushed first), and returns the number of results. Any other+-- value in the stack below the results will be properly discarded by+-- Lua. Like a Lua function, a C function called by Lua can also return+-- many results.+--+-- See <https://www.lua.org/manual/5.3/manual.html#lua_CFunction lua_CFunction>.+type CFunction = FunPtr (State -> IO NumResults)++-- | The reader function used by @'Foreign.Lua.Core.Functions.load'@.+-- Every time it needs another piece of the chunk, lua_load calls the+-- reader, passing along its data parameter. The reader must return a+-- pointer to a block of memory with a new piece of the chunk and set+-- size to the block size. The block must exist until the reader+-- function is called again. To signal the end of the chunk, the reader+-- must return @NULL@ or set size to zero. The reader function may+-- return pieces of any size greater than zero.+--+-- See <https://www.lua.org/manual/5.3/manual.html#lua_Reader lua_Reader>.+type Reader = FunPtr (State -> Ptr () -> Ptr CSize -> IO (Ptr CChar))++-- |  The type of integers in Lua.+--+-- By default this type is @'Int64'@, but that can be changed to different+-- values in lua. (See @LUA_INT_TYPE@ in @luaconf.h@.)+--+-- See <https://www.lua.org/manual/5.3/manual.html#lua_Integer lua_Integer>.+newtype Integer = Integer #{type LUA_INTEGER}+  deriving (Bounded, Enum, Eq, Integral, Num, Ord, Real, Show)++-- |  The type of floats in Lua.+--+-- By default this type is @'Double'@, but that can be changed in Lua to a+-- single float or a long double. (See @LUA_FLOAT_TYPE@ in @luaconf.h@.)+--+-- See <https://www.lua.org/manual/5.3/manual.html#lua_Number lua_Number>.+newtype Number = Number #{type LUA_NUMBER}+  deriving (Eq, Floating, Fractional, Num, Ord, Real, RealFloat, RealFrac, Show)+++--+-- LuaBool+--++-- | Boolean value returned by a Lua C API function. This is a @'CInt'@ and+-- interpreted as @'False'@ iff the value is @0@, @'True'@ otherwise.+newtype LuaBool = LuaBool CInt+  deriving (Eq, Storable, Show)++-- | Generic Lua representation of a value interpreted as being true.+true :: LuaBool+true = LuaBool 1++-- | Lua representation of the value interpreted as false.+false :: LuaBool+false = LuaBool 0++-- | Convert a @'LuaBool'@ to a Haskell @'Bool'@.+fromLuaBool :: LuaBool -> Bool+fromLuaBool (LuaBool 0) = False+fromLuaBool _           = True+{-# INLINABLE fromLuaBool #-}++-- | Convert a Haskell @'Bool'@ to a @'LuaBool'@.+toLuaBool :: Bool -> LuaBool+toLuaBool True  = true+toLuaBool False = false+{-# INLINABLE toLuaBool #-}+++--+-- * Type of Lua values+--++-- | Enumeration used as type tag.+-- See <https://www.lua.org/manual/5.3/manual.html#lua_type lua_type>.+data Type+  = TypeNone           -- ^ non-valid stack index+  | TypeNil            -- ^ type of lua's @nil@ value+  | TypeBoolean        -- ^ type of lua booleans+  | TypeLightUserdata  -- ^ type of light userdata+  | TypeNumber         -- ^ type of lua numbers. See @'Lua.Number'@+  | TypeString         -- ^ type of lua string values+  | TypeTable          -- ^ type of lua tables+  | TypeFunction       -- ^ type of functions, either normal or @'CFunction'@+  | TypeUserdata       -- ^ type of full user data+  | TypeThread         -- ^ type of lua threads+  deriving (Bounded, Eq, Ord, Show)++-- | Integer code used to encode the type of a lua value.+newtype TypeCode = TypeCode { fromTypeCode :: CInt }+  deriving (Eq, Ord, Show)++instance Enum Type where+  fromEnum = fromIntegral . fromTypeCode . fromType+  toEnum = toType . TypeCode . fromIntegral++-- | Convert a lua Type to a type code which can be passed to the C API.+fromType :: Type -> TypeCode+fromType tp = TypeCode $ case tp of+  TypeNone          -> #{const LUA_TNONE}+  TypeNil           -> #{const LUA_TNIL}+  TypeBoolean       -> #{const LUA_TBOOLEAN}+  TypeLightUserdata -> #{const LUA_TLIGHTUSERDATA}+  TypeNumber        -> #{const LUA_TNUMBER}+  TypeString        -> #{const LUA_TSTRING}+  TypeTable         -> #{const LUA_TTABLE}+  TypeFunction      -> #{const LUA_TFUNCTION}+  TypeUserdata      -> #{const LUA_TUSERDATA}+  TypeThread        -> #{const LUA_TTHREAD}++-- | Convert numerical code to lua type.+toType :: TypeCode -> Type+toType (TypeCode c) = case c of+  #{const LUA_TNONE}          -> TypeNone+  #{const LUA_TNIL}           -> TypeNil+  #{const LUA_TBOOLEAN}       -> TypeBoolean+  #{const LUA_TLIGHTUSERDATA} -> TypeLightUserdata+  #{const LUA_TNUMBER}        -> TypeNumber+  #{const LUA_TSTRING}        -> TypeString+  #{const LUA_TTABLE}         -> TypeTable+  #{const LUA_TFUNCTION}      -> TypeFunction+  #{const LUA_TUSERDATA}      -> TypeUserdata+  #{const LUA_TTHREAD}        -> TypeThread+  _ -> error ("No Type corresponding to " ++ show c)++--+-- * Relational Operator+--++-- | Lua comparison operations.+data RelationalOperator+  = EQ -- ^ Correponds to lua's equality (==) operator.+  | LT -- ^ Correponds to lua's strictly-lesser-than (<) operator+  | LE -- ^ Correponds to lua's lesser-or-equal (<=) operator+  deriving (Eq, Ord, Show)++-- | Convert relation operator to its C representation.+fromRelationalOperator :: RelationalOperator -> CInt+fromRelationalOperator EQ = #{const LUA_OPEQ}+fromRelationalOperator LT = #{const LUA_OPLT}+fromRelationalOperator LE = #{const LUA_OPLE}+{-# INLINABLE fromRelationalOperator #-}+++--+-- * Status+--++-- | Lua status values.+data Status+  = OK        -- ^ success+  | Yield     -- ^ yielding / suspended coroutine+  | ErrRun    -- ^ a runtime rror+  | ErrSyntax -- ^ syntax error during precompilation+  | ErrMem    -- ^ memory allocation (out-of-memory) error.+  | ErrErr    -- ^ error while running the message handler.+  | ErrGcmm   -- ^ error while running a @__gc@ metamethod.+  | ErrFile   -- ^ opening or reading a file failed.+  deriving (Eq, Show)++-- | Convert C integer constant to @'Status'@.+toStatus :: StatusCode -> Status+toStatus (StatusCode c) = case c of+  #{const LUA_OK}        -> OK+  #{const LUA_YIELD}     -> Yield+  #{const LUA_ERRRUN}    -> ErrRun+  #{const LUA_ERRSYNTAX} -> ErrSyntax+  #{const LUA_ERRMEM}    -> ErrMem+  #{const LUA_ERRGCMM}   -> ErrGcmm+  #{const LUA_ERRERR}    -> ErrErr+  #{const LUA_ERRFILE}   -> ErrFile+  n -> error $ "Cannot convert (" ++ show n ++ ") to Status"+{-# INLINABLE toStatus #-}++-- | Integer code used to signal the status of a thread or computation.+-- See @'Status'@.+newtype StatusCode = StatusCode CInt deriving (Eq, Storable)+++--+-- * Gargabe Collection Control+--++-- | Enumeration used by @gc@ function.+data GCCONTROL+  = GCSTOP+  | GCRESTART+  | GCCOLLECT+  | GCCOUNT+  | GCCOUNTB+  | GCSTEP+  | GCSETPAUSE+  | GCSETSTEPMUL+  deriving (Enum, Eq, Ord, Show)++-- | A stack index+newtype StackIndex = StackIndex { fromStackIndex :: CInt }+  deriving (Enum, Eq, Num, Ord, Show)++--+-- Number of arguments and return values+--++-- | The number of arguments consumed curing a function call.+newtype NumArgs = NumArgs { fromNumArgs :: CInt }+  deriving (Eq, Num, Ord, Show)++-- | The number of results returned by a function call.+newtype NumResults = NumResults { fromNumResults :: CInt }+  deriving (Eq, Num, Ord, Show)

@@ -0,0 +1,65 @@+{-# LANGUAGE CPP #-}+{-|+Module      : Foreign.Lua.Raw.Userdata+Copyright   : © 2017-2020 Albert Krewinkel+License     : MIT+Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de>+Stability   : beta+Portability : ForeignFunctionInterface++Bindings to HsLua-specific functions used to push Haskell values+as userdata.+-}+module Foreign.Lua.Raw.Userdata+  ( hslua_fromuserdata+  , hslua_newhsuserdata+  , hslua_newudmetatable+  ) where++import Foreign.C (CInt (CInt), CString)+import Foreign.Lua.Raw.Auxiliary (luaL_testudata)+import Foreign.Lua.Raw.Functions (lua_newuserdata)+import Foreign.Lua.Raw.Types+  ( LuaBool (..)+  , StackIndex (..)+  , State (..)+  )+import Foreign.Ptr (castPtr, nullPtr)+import Foreign.StablePtr (newStablePtr, deRefStablePtr)+import Foreign.Storable (peek, poke, sizeOf)++#ifdef ALLOW_UNSAFE_GC+#define SAFTY unsafe+#else+#define SAFTY safe+#endif++-- | Creates and registers a new metatable for a userdata-wrapped+-- Haskell value; checks whether a metatable of that name has been+-- registered yet and uses the registered table if possible.+foreign import ccall SAFTY "hsludata.h hslua_newudmetatable"+  hslua_newudmetatable :: State       -- ^ Lua state+                       -> CString     -- ^ Userdata name (__name)+                       -> IO LuaBool  -- ^ True iff new metatable+                                      --   was created.++-- | Creates a new userdata wrapping the given Haskell object.+hslua_newhsuserdata :: State -> a -> IO ()+hslua_newhsuserdata l x = do+  xPtr <- newStablePtr x+  udPtr <- lua_newuserdata l (fromIntegral $ sizeOf xPtr)+  poke (castPtr udPtr) xPtr+{-# INLINABLE hslua_newhsuserdata #-}++-- | Retrieves a Haskell object from userdata at the given index.+-- The userdata /must/ have the given name.+hslua_fromuserdata :: State+                   -> StackIndex  -- ^ userdata index+                   -> CString     -- ^ name+                   -> IO (Maybe a)+hslua_fromuserdata l idx name = do+  udPtr <- luaL_testudata l idx name+  if udPtr == nullPtr+    then return Nothing+    else Just <$> (peek (castPtr udPtr) >>= deRefStablePtr)+{-# INLINABLE hslua_fromuserdata #-}

@@ -39,19 +39,20 @@   , metatableName   ) where --- import Control.Applicative (empty) import Control.Monad (when) import Data.Data (Data, dataTypeName, dataTypeOf)+import Foreign.C (withCString) import Foreign.Lua.Core (Lua)+import Foreign.Lua.Core.Types (liftLua, fromLuaBool)+import Foreign.Lua.Raw.Userdata+  ( hslua_fromuserdata+  , hslua_newhsuserdata+  , hslua_newudmetatable+  ) import Foreign.Lua.Types.Peekable (reportValueOnFailure)  import qualified Foreign.Lua.Core as Lua-import qualified Foreign.C as C-import qualified Foreign.Ptr as Ptr-import qualified Foreign.StablePtr as StablePtr-import qualified Foreign.Storable as Storable - -- | Push data by wrapping it into a userdata object. pushAny :: Data a         => a@@ -67,9 +68,7 @@                      -> a            -- ^ object to push to Lua.                      -> Lua () pushAnyWithMetatable mtOp x = do-  xPtr <- Lua.liftIO (StablePtr.newStablePtr x)-  udPtr <- Lua.newuserdata (Storable.sizeOf xPtr)-  Lua.liftIO $ Storable.poke (Ptr.castPtr udPtr) xPtr+  liftLua $ \l -> hslua_newhsuserdata l x   mtOp   Lua.setmetatable (Lua.nthFromTop 2)   return ()@@ -84,17 +83,10 @@                                       -- the stack.                         -> Lua () ensureUserdataMetatable name modMt = do-  mtCreated <- Lua.newmetatable name-  when mtCreated $ do-    -- Prevent accessing or changing the metatable with-    -- getmetatable/setmetatable.-    Lua.pushboolean True-    Lua.setfield (Lua.nthFromTop 2) "__metatable"-    -- Mark objects for finalization when collecting garbage.-    Lua.pushcfunction hslua_userdata_gc_ptr-    Lua.setfield (Lua.nthFromTop 2) "__gc"-    -- Execute additional modifications on metatable-    modMt+  mtCreated <- liftLua $ \l ->+    fromLuaBool <$> withCString name (hslua_newudmetatable l)+  -- Execute additional modifications on metatable+  when mtCreated modMt  -- | Retrieve data which has been pushed with @'pushAny'@. toAny :: Data a => Lua.StackIndex -> Lua (Maybe a)@@ -108,14 +100,8 @@ toAnyWithName :: Lua.StackIndex               -> String         -- ^ expected metatable name               -> Lua (Maybe a)-toAnyWithName idx name = do-  l <- Lua.state-  udPtr <- Lua.liftIO (C.withCString name (luaL_testudata l idx))-  if udPtr == Ptr.nullPtr-    then return Nothing-    else-      fmap Just . Lua.liftIO $-      Storable.peek (Ptr.castPtr udPtr) >>= StablePtr.deRefStablePtr+toAnyWithName idx name = liftLua $ \l ->+  withCString name (hslua_fromuserdata l idx)  -- | Retrieve Haskell data which was pushed to Lua as userdata. peekAny :: Data a => Lua.StackIndex -> Lua a@@ -128,14 +114,3 @@ -- the given type as userdata.  The argument is never evaluated. metatableName :: Data a => a -> String metatableName x = "HSLUA_" ++ dataTypeName (dataTypeOf x)---- | Function to free the stable pointer in a userdata, ensuring the Haskell--- value can be garbage collected. This function does not call back into--- Haskell, making is safe to call even from functions imported as unsafe.-foreign import ccall "&hslua_userdata_gc"-  hslua_userdata_gc_ptr :: Lua.CFunction---- | See--- <https://www.lua.org/manual/5.3/manual.html#luaL_testudata luaL_testudata>-foreign import ccall "luaL_testudata"-  luaL_testudata :: Lua.State -> Lua.StackIndex -> C.CString -> IO (Ptr.Ptr ())

@@ -0,0 +1,142 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-|+Module      : Foreign.Lua.CallTests+Copyright   : © 2020 Albert Krewinkel+License     : MIT+Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de>+Stability   : alpha+Portability : OverloadedStrings, TypeApplications++Tests for calling exposed Haskell functions.+-}+module Foreign.Lua.CallTests (tests) where++import Foreign.Lua.Core (StackIndex)+import Foreign.Lua.Call+import Foreign.Lua.Peek (peekIntegral, peekText, force)+import Foreign.Lua.Push (pushIntegral)+import Test.HsLua.Util ((=:), shouldBeResultOf)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit ((@=?))++import qualified Data.Text as T+import qualified Foreign.Lua as Lua++-- | Calling Haskell functions from Lua.+tests :: TestTree+tests = testGroup "Call"+  [ testGroup "push Haskell function"+    [ "HaskellFunction building" =:+      720+      `shouldBeResultOf` do+        factLua <- factLuaAtIndex <$> Lua.gettop+        Lua.pushinteger 6+        _ <- callFunction factLua+        peekIntegral @Integer Lua.stackTop >>= force++    , "error message" =:+      mconcat [ "retrieving function argument n"+              , "\n\texpected Integral, got 'true' (boolean)"]+      `shouldBeResultOf` do+        factLua <- factLuaAtIndex <$> Lua.gettop+        Lua.pushboolean True+        _ <- callFunction factLua+        peekText Lua.stackTop >>= force+    ]+  , testGroup "use as C function"+    [ "push factorial" =:+      Lua.TypeFunction+      `shouldBeResultOf` do+        pushHaskellFunction $ factLuaAtIndex 0+        Lua.ltype Lua.stackTop+    , "call factorial" =:+      120+      `shouldBeResultOf` do+        pushHaskellFunction $ factLuaAtIndex 0+        Lua.pushinteger 5+        Lua.call 1 1+        peekIntegral @Integer Lua.stackTop >>= force+    , "use from Lua" =:+      24+      `shouldBeResultOf` do+        pushHaskellFunction $ factLuaAtIndex 0+        Lua.setglobal "factorial"+        Lua.loadstring "return factorial(4)" *> Lua.call 0 1+        peekIntegral @Integer Lua.stackTop >>= force+    ]+  , testGroup "documentation"+    [ "rendered docs" =:+      (T.unlines+       [ "Parameters:"+       , ""+       , "n"+       , ":   number for which the factorial is computed (integer)"+       , ""+       , "Returns:"+       , ""+       , " - factorial (integer)"+       ]+       @=?+       maybe "" render (functionDoc (factLuaAtIndex 0)))+    ]++  , testGroup "helpers"+    [ "parameter doc" =:+      ( ParameterDoc+        { parameterName = "test"+        , parameterDescription = "test param"+        , parameterType = "string"+        , parameterIsOptional = False+        }+        @=?+        parameterDoc (parameter peekText "string" "test" "test param")+      )+    , "optionalParameter doc" =:+      ( ParameterDoc+        { parameterName = "test"+        , parameterDescription = "test param"+        , parameterType = "string"+        , parameterIsOptional = True+        }+        @=?+        parameterDoc (optionalParameter peekText "string" "test" "test param")+      )+    , "functionResult doc" =:+      ( FunctionResultDoc+        { functionResultDescription = "int result"+        , functionResultType = "integer"+        }+        @=?+        (fnResultDoc . head $+         functionResult (pushIntegral @Int) "integer" "int result")+      )+    ]+  ]++factLuaAtIndex :: StackIndex -> HaskellFunction+factLuaAtIndex idx =+  toHsFnPrecursorWithStartIndex idx factorial+  <#> factorialParam+  =#> factorialResult++-- | Calculate the factorial of a number.+factorial :: Integer -> Integer+factorial n = product [1..n]++factorialParam :: Parameter Integer+factorialParam = Parameter+  { parameterDoc = ParameterDoc+    { parameterName = "n"+    , parameterType = "integer"+    , parameterDescription = "number for which the factorial is computed"+    , parameterIsOptional = False+    }+  , parameterPeeker = peekIntegral @Integer+  }++factorialResult :: FunctionResults Integer+factorialResult = (:[]) $ FunctionResult+  (pushIntegral @Integer)+  (FunctionResultDoc "integer" "factorial")

@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-} {-| Module      : Foreign.Lua.ModuleTests Copyright   : © 2019-2020 Albert Krewinkel@@ -12,10 +13,15 @@ module Foreign.Lua.ModuleTests (tests) where  import Foreign.Lua (Lua)-import Foreign.Lua.Module (addfield, addfunction, create, preloadhs, requirehs)+import Foreign.Lua.Call hiding (render)+import Foreign.Lua.Module+import Foreign.Lua.Peek (peekIntegral)+import Foreign.Lua.Push (pushIntegral) import Test.HsLua.Util ((=:), pushLuaExpr, shouldBeResultOf) import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit ((@=?)) +import qualified Data.Text as T import qualified Foreign.Lua as Lua  -- | Specifications for Attributes parsing functions.@@ -79,4 +85,68 @@         Lua.call 1 1         Lua.peek Lua.stackTop     ]+  , testGroup "module type"+    [ "register module" =:+      1 `shouldBeResultOf` do+        Lua.openlibs+        old <- Lua.gettop+        registerModule mymath+        new <- Lua.gettop+        return (new - old)++    , "call module function" =:+      Right 24 `shouldBeResultOf` do+        Lua.openlibs+        registerModule mymath+        _ <- Lua.dostring $ mconcat+             [ "local mymath = require 'mymath'\n"+             , "return mymath.factorial(4)"+             ]+        peekIntegral @Integer Lua.stackTop+    ]+  , testGroup "documentation"+    [ "module docs" =:+      (T.intercalate "\n"+        [ "# mymath"+        , ""+        , "A math module."+        , ""+        , "## Functions"+        , ""+        , "### factorial (n)"+        , ""+        , "Parameters:"+        , ""+        , "n"+        , ":   number for which the factorial is computed (integer)"+        , ""+        , "Returns:"+        , ""+        , " - factorial (integer)\n"+        ] @=?+        render mymath)+    ]   ]++mymath :: Module+mymath = Module+  { moduleName = "mymath"+  , moduleDescription = "A math module."+  , moduleFields = []+  , moduleFunctions = [ ("factorial", factorial)]+  }++factorial :: HaskellFunction+factorial = toHsFnPrecursor (\n -> product [1..n])+  <#> factorialParam+  =#> factorialResult++factorialParam :: Parameter Integer+factorialParam =+  parameter (peekIntegral @Integer) "integer"+    "n"+    "number for which the factorial is computed"++factorialResult :: FunctionResults Integer+factorialResult =+  functionResult (pushIntegral @Integer) "integer" "factorial"

@@ -270,4 +270,15 @@           peekMap (peekIntegral @Int) peekText Lua.stackTop       ]     ]++  , testGroup "combinators"+    [ "optional with nil" =:+      Right Nothing `shouldBeResultOf` do+        Lua.pushnil+        optional peekString Lua.top+    , "optional with number" =:+      Right (Just 23) `shouldBeResultOf` do+        Lua.pushinteger 23+        optional (peekIntegral @Int) Lua.top+    ]   ]

@@ -142,7 +142,7 @@           tableSize <- run $ Lua.run $ do             pushList pushString list             Lua.rawlen Lua.stackTop-          assert $ fromIntegral tableSize == length list+          assert $ tableSize == length list        , testSingleElementProperty (pushList pushText)       ]

@@ -22,6 +22,7 @@ import Test.Tasty (TestTree, defaultMain, testGroup)  import qualified Foreign.LuaTests+import qualified Foreign.Lua.CallTests import qualified Foreign.Lua.CoreTests import qualified Foreign.Lua.FunctionCallingTests import qualified Foreign.Lua.ModuleTests@@ -50,6 +51,7 @@     ]   , Foreign.Lua.UserdataTests.tests   , Foreign.Lua.ModuleTests.tests+  , Foreign.Lua.CallTests.tests   , Foreign.LuaTests.tests   , Foreign.Lua.PeekTests.tests   ]