packages feed

hslua-objectorientation (empty) → 2.0.0

raw patch · 9 files changed

+1356/−0 lines, 9 filesdep +QuickCheckdep +basedep +bytestring

Dependencies added: QuickCheck, base, bytestring, containers, exceptions, hslua-core, hslua-marshalling, hslua-objectorientation, lua-arbitrary, mtl, quickcheck-instances, tasty, tasty-hslua, tasty-hunit, tasty-quickcheck, text

Files

+ CHANGELOG.md view
@@ -0,0 +1,11 @@+# Changelog++`hslua-objectorientation` uses [PVP Versioning][1].++## hslua-objectorientation 1.0.0++Release pending.++- Published without warning.++[1]: https://pvp.haskell.org
+ LICENSE view
@@ -0,0 +1,23 @@+Copyright © 1994-2020 Lua.org, PUC-Rio.+Copyright © 2007-2012 Gracjan Polak+Copyright © 2012-2015 Ömer Sinan Ağacan+Copyright © 2016-2021 Albert Krewinkel++Permission is hereby granted, free of charge, to any person obtaining a+copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,13 @@+# hslua-objectorientation++[![Build status][GitHub Actions badge]][GitHub Actions]+[![AppVeyor Status]](https://ci.appveyor.com/project/tarleb/hslua-r2y18)+[![Hackage]](https://hackage.haskell.org/package/hslua-objectorientation)++Expose Haskell data to Lua with an object oriented interface.+++[GitHub Actions badge]: https://img.shields.io/github/workflow/status/hslua/hslua/CI.svg?logo=github+[GitHub Actions]: https://github.com/hslua/hslua/actions+[AppVeyor Status]: https://ci.appveyor.com/api/projects/status/ldutrilgxhpcau94/branch/main?svg=true+[Hackage]: https://img.shields.io/hackage/v/hslua-objectorientation.svg
+ cbits/hslobj.c view
@@ -0,0 +1,280 @@+#include <HsFFI.h>+#include <lua.h>+#include <lauxlib.h>+#include <string.h>++/* ***************************************************************+ * Helpers for fast element access+ * ***************************************************************/++/*+** Pushes the caching table of the userdata at index `idx` to the stack.+**+** Creates and sets a new table if none has been attached to the+** userdata yet.+*/+void hsluaO_get_caching_table(lua_State *L, int idx)+{+  int absidx = lua_absindex(L, idx);+  if (lua_getuservalue(L, idx) == LUA_TTABLE) {+    return;+  }++  /* No caching table set yet; create table and add to object. */+  lua_pop(L, 1);                        /* remove nil */+  lua_createtable(L, 0, 0);+  lua_pushvalue(L, -1);+  lua_setuservalue(L, idx);+}++/*+** Retrieve a value from the wrapped userdata project. The userdata must+** be in position 1, and the key in position 2. Returns 1 if a value was+** found and is at the top of the stack, 0 otherwise. Does not clean-up+** on success.+*/+int hsluaO_get_from_cache(lua_State *L)+{+  /* Use value in caching table if present */+  hsluaO_get_caching_table(L, 1);       /* table */+  lua_pushvalue(L, 2);                  /* key */+  if (lua_rawget(L, 3) == LUA_TNIL) {+    lua_pop(L, 2);                      /* remove nil, caching table */+    return 0;+  }+  /* found the key in the cache */+  return 1;+}+++/*+** Retrieve a value from the wrapped userdata project.+** The userdata must be in position 1, and the key in position 2.+ */+int hsluaO_get_via_getter(lua_State *L)+{+  /* Bail if there are no getterns, or no getter for the given key. */+  if (luaL_getmetafield(L, 1, "getters") != LUA_TTABLE) {+    return 0;+  }+  lua_pushvalue(L, 2);                  /* key */+  if (lua_rawget(L, -2) == LUA_TNIL) {+    lua_pop(L, 1);+    return 0;+  }++  /* Call getter. Slow, as it calls into Haskell. */+  lua_pushvalue(L, 1);+  lua_call(L, 1, 1);++  /* key found in wrapped userdata, add to caching table */+  hsluaO_get_caching_table(L, 1);       /* object's caching table */+  lua_pushvalue(L, 2);                  /* key */+  lua_pushvalue(L, -3);                 /* value */+  lua_rawset(L, -3);+  lua_pop(L, 1);                        /* pop caching table */+  /* return value */+  return 1;+}++/*+** Retrieve a value by using the key as the alias for a different+** property. The userdata must be in position 1, and the key in position+** 2.+*/+int hsluaO_get_via_alias(lua_State *L)+{+  if (luaL_getmetafield(L, 1, "aliases") != LUA_TTABLE) {+    return 0;             /* no aliases available */+  }+  lua_pushvalue(L, 2);+  if (lua_rawget(L, -2) != LUA_TTABLE) {+    return 0;             /* key is not an alias */+  }++  /* key is an alias */+  lua_pushvalue(L, 1);    /* start with the original object */+  /* Iterate over properties; last object is on top of stack,+   * list of properties is the second object. */+  for (int i = 1; i <= lua_rawlen(L, -2); i++) {+    lua_rawgeti(L, -2, i);+    lua_gettable(L, -2);  /* get property */+    lua_remove(L, -2);    /* remove previous object */+  }+  return 1;+}++/*+** Retrieve a method for this object. The userdata must be in position+** 1, and the key in position 2.+*/+int hsluaO_get_method(lua_State *L)+{+  if (luaL_getmetafield(L, 1, "methods") != LUA_TTABLE) {+    lua_pop(L, 1);+    return 0;+  }+  lua_pushvalue(L, 2);+  lua_rawget(L, -2);+  return 1;+}++/*+** Retrieve a numerical index from this object. The userdata must be in+** position 1, and the key in position 2.+*/+int hsluaO_get_numerical(lua_State *L)+{+  hsluaO_get_caching_table(L, 1);+  int requested = lua_tointeger(L, 2);++  lua_getfield(L, 1, "__lazylistindex");+  int last_index = lua_tointeger(L, -1);+  lua_pop(L, 1);                        /* pop last-index value */++  if (requested > last_index) {+    /* index not in cache, force lazy evaluation of list items */+    if (luaL_getmetafield(L, 1, "lazylisteval") == LUA_TFUNCTION &&+        lua_getfield(L, 3, "__lazylist") == LUA_TUSERDATA) {+      lua_pushinteger(L, last_index);+      lua_pushinteger(L, requested);+      lua_pushvalue(L, 3);              /* caching table */+      lua_call(L, 4, 0);                /* populate cache with evaled values */+    }+  }+  lua_rawgeti(L, 3, requested);+  return 1;+}++/*+** Retrieves a key from a Haskell-data holding userdata value.+**+** If the key is an integer, any associated list is evaluated and the+** result is stored in the cache before it is returned.+**+** For non-integer keys, it tries the following, in order, and returns+** the first non-nil result:+**+**   + Checks the userdata's uservalue table for the given key;+**   + looks up a `getter` for the key and calls it with the userdata and+**     key as arguments;+**   + tries to lookup the key as an alias and retrieves the value of the+**     alias;+**   + looks up the key in the table in the `methods` metafield.+*/+int hslua_udindex(lua_State *L)+{+  lua_settop(L, 2);+  /* do numeric lookup for integer keys */+  return lua_isinteger(L, 2)+    ? hsluaO_get_numerical(L)+    /* try various sources in order; return 0 if nothing is found. */+    : (hsluaO_get_from_cache(L)+       || hsluaO_get_via_getter(L)+       || hsluaO_get_via_alias(L)+       || hsluaO_get_method(L));+}++/*+** Set value via a property alias. Assumes the stack to be in a state as+** after __newindex is called. Returns 1 on success, and 0 otherwise.+ */+int hsluaO_set_via_alias(lua_State *L)+{+  if (luaL_getmetafield(L, 1, "aliases") != LUA_TTABLE) {+    return 0;+  }+  lua_pushvalue(L, 2);+  if (lua_rawget(L, -2) != LUA_TTABLE) { /* key is an alias */+    lua_pop(L, 2);+    return 0;+  }+  lua_pushvalue(L, 1);    /* start with the original object */+  /* Iterate over properties; last object is on top of stack,+   * list of properties is the second object. */+  for (int i = 1; i < lua_rawlen(L, -2); i++) {+    lua_rawgeti(L, -2, i);+    lua_gettable(L, -2);  /* get property */+    lua_remove(L, -2);    /* remove previous object */+  }+  lua_rawgeti(L, -2, lua_rawlen(L, -2)); /* last element */+  lua_pushvalue(L, 3);    /* new value */+  lua_settable(L, -3);+  return 1;+}++/*+** Set value via a property alias. Assumes the stack to be in a state as+** after __newindex is called. Returns 1 on success, 0 if the object is+** readonly, and throws an error if there is no setter for the given+** key.+*/+int hsluaO_set_via_setter(lua_State *L)+{+  if (luaL_getmetafield(L, 1, "setters") != LUA_TTABLE)+    return 0;++  lua_pushvalue(L, 2);                  /* key */+  if (lua_rawget(L, -2) != LUA_TFUNCTION) {+    lua_pop(L, 1);+    lua_pushliteral(L, "Cannot set unknown property.");+    return lua_error(L);+  }++  lua_insert(L, 1);+  lua_settop(L, 4);       /* 1: setter, 2: ud, 3: key, 4: value */+  lua_call(L, 3, 0);+  return 1;+}++/*+** Sets a new value in the userdata caching table via a setter+** functions.+**+** The actual assignment is performed by a setter function stored in the+** `setter` metafield. Throws an error if no setter function can be+** found.+ */+int hslua_udnewindex(lua_State *L)+{+  if (lua_type(L, 2) == LUA_TNUMBER) {+    lua_pushliteral(L, "Cannot set a numerical value.");+    return lua_error(L);+  }+  if (hsluaO_set_via_alias(L) || hsluaO_set_via_setter(L)) {+    return 0;+  }++  lua_pushliteral(L, "Cannot modify read-only object.");+  return lua_error(L);+}++/*+** Sets a value in the userdata's caching table (uservalue). Takes the+** same arguments as a `__newindex` function.+*/+int hslua_udsetter(lua_State *L)+{+  luaL_checkany(L, 3);+  lua_settop(L, 3);+  hsluaO_get_caching_table(L, 1);+  lua_insert(L, 2);+  lua_rawset(L, 2);+  return 0;+}++/*+** Throws an error noting that the given key is read-only.+*/+int hslua_udreadonly(lua_State *L)+{+  if (lua_type(L, 2) == LUA_TSTRING && lua_checkstack(L, 3)) {+    lua_pushliteral(L, "'");+    lua_pushvalue(L, 2);+    lua_pushliteral(L, "' is a read-only property.");+    lua_concat(L, 3);+  } else {+    lua_pushliteral(L, "Cannot set read-only value.");+  }+  return lua_error(L);+}
+ hslua-objectorientation.cabal view
@@ -0,0 +1,83 @@+cabal-version:       2.2+name:                hslua-objectorientation+version:             2.0.0+synopsis:            Object orientation tools for HsLua+description:         Expose Haskell objects to Lua with an object oriented+                     interface.+homepage:            https://hslua.org/+bug-reports:         https://github.com/hslua/hslua/issues+license:             MIT+license-file:        LICENSE+author:              Albert Krewinkel+maintainer:          albert+hslua@zeitkraut.de+copyright:           © 2021 Albert Krewinkel+category:            Foreign+build-type:          Simple+extra-source-files:  README.md+                   , CHANGELOG.md+tested-with:         GHC == 8.0.2+                   , GHC == 8.2.2+                   , GHC == 8.4.4+                   , GHC == 8.6.5+                   , GHC == 8.8.4+                   , GHC == 8.10.4+                   , GHC == 9.0.1++source-repository head+  type:                git+  location:            https://github.com/hslua/hslua.git+  subdir:              hslua-objectorientation++common common-options+  default-language:    Haskell2010+  build-depends:       base              >= 4.8    && < 5+                     , bytestring        >= 0.10.2 && < 0.12+                     , containers        >= 0.5.9  && < 0.7+                     , exceptions        >= 0.8    && < 0.11+                     , hslua-core        >= 2.0    && < 2.1+                     , hslua-marshalling >= 2.0    && < 2.1+                     , mtl               >= 2.2    && < 2.3+                     , text              >= 1.0    && < 1.3+  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+  other-extensions:    OverloadedStrings+                     , TypeApplications++library+  import:              common-options+  exposed-modules:     HsLua.ObjectOrientation+                     , HsLua.ObjectOrientation.Operation+  hs-source-dirs:      src+  default-extensions:  LambdaCase+  other-extensions:    AllowAmbiguousTypes+                     , CPP+                     , FlexibleInstances+                     , MultiParamTypeClasses+                     , ScopedTypeVariables+  c-sources:           cbits/hslobj.c++test-suite test-hslua-objectorientation+  import:              common-options+  type:                exitcode-stdio-1.0+  main-is:             test-hslua-objectorientation.hs+  hs-source-dirs:      test+  ghc-options:         -threaded -Wno-unused-do-bind+  other-modules:       HsLua.ObjectOrientationTests+  build-depends:       hslua-objectorientation+                     , lua-arbitrary        >= 1.0+                     , QuickCheck           >= 2.7+                     , quickcheck-instances >= 0.3+                     , tasty                >= 0.11+                     , tasty-hslua          >= 1.0+                     , tasty-hunit          >= 0.9+                     , tasty-quickcheck     >= 0.8
+ src/HsLua/ObjectOrientation.hs view
@@ -0,0 +1,407 @@+{-# LANGUAGE CPP                 #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications    #-}+{-|+Module      : HsLua.ObjectOrientation+Copyright   : © 2021 Albert Krewinkel+License     : MIT+Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de>++This module provides types and functions to use Haskell values as+userdata objects in Lua. These objects wrap a Haskell value and provide+methods and properties to interact with the Haskell value.++The terminology in this module refers to the userdata values as /UD+objects/, and to their type as /UD type/.+-}+module HsLua.ObjectOrientation+  ( UDType+  , UDTypeWithList (..)+  , deftypeGeneric+  , deftypeGeneric'+  , methodGeneric+  , property+  , possibleProperty+  , readonly+  , alias+  , peekUD+  , pushUD+    -- * Helper types for building+  , Member+  , Property+  , Operation (..)+  , ListSpec+  , Possible (..)+  , AliasIndex (..)+  ) where++import Control.Monad.Except+import Foreign.Ptr (FunPtr)+import Data.Maybe (mapMaybe)+import Data.Map (Map)+#if !MIN_VERSION_base(4,12,0)+import Data.Semigroup (Semigroup ((<>)))+#endif+import Data.String (IsString (..))+import Data.Text (Text)+import Data.Void (Void)+import HsLua.Core as Lua+import HsLua.Marshalling+import HsLua.ObjectOrientation.Operation+import qualified Data.Map.Strict as Map+import qualified HsLua.Core.Unsafe as Unsafe+import qualified HsLua.Core.Utf8 as Utf8++-- | A userdata type, capturing the behavior of Lua objects that wrap+-- Haskell values. The type name must be unique; once the type has been+-- used to push or retrieve a value, the behavior can no longer be+-- modified through this type.+data UDTypeWithList e fn a itemtype = UDTypeWithList+  { udName          :: Name+  , udOperations    :: [(Operation, fn)]+  , udProperties    :: Map Name (Property e a)+  , udMethods       :: Map Name fn+  , udAliases       :: Map Name Alias+  , udListSpec      :: Maybe (ListSpec e a itemtype)+  , udFnPusher      :: fn -> LuaE e ()+  }++type ListSpec e a itemtype = (a -> [itemtype], Pusher e itemtype)++type UDType e fn a = UDTypeWithList e fn a Void++-- | Defines a new type, defining the behavior of objects in Lua.+-- Note that the type name must be unique.+deftypeGeneric :: Pusher e fn           -- ^ function pusher+               -> Name                  -- ^ type name+               -> [(Operation, fn)]     -- ^ operations+               -> [Member e fn a]       -- ^ methods+               -> UDType e fn a+deftypeGeneric pushFunction name ops members =+  deftypeGeneric' pushFunction name ops members Nothing++-- | Defines a new type that could also be treated as a list; defines+-- the behavior of objects in Lua. Note that the type name must be+-- unique.+deftypeGeneric' :: Pusher e fn          -- ^ function pusher+                -> Name                 -- ^ type name+                -> [(Operation, fn)]    -- ^ operations+                -> [Member e fn a]      -- ^ methods+                -> Maybe (ListSpec e a itemtype)  -- ^ list access+                -> UDTypeWithList e fn a itemtype+deftypeGeneric' pushFunction name ops members mbListSpec = UDTypeWithList+  { udName          = name+  , udOperations    = ops+  , udProperties    = Map.fromList $ mapMaybe mbproperties members+  , udMethods       = Map.fromList $ mapMaybe mbmethods members+  , udAliases       = Map.fromList $ mapMaybe mbaliases members+  , udListSpec      = mbListSpec+  , udFnPusher      = pushFunction+  }+  where+    mbproperties = \case+      MemberProperty n p -> Just (n, p)+      _ -> Nothing+    mbmethods = \case+      MemberMethod n m -> Just (n, m)+      _ -> Nothing+    mbaliases = \case+      MemberAlias n a -> Just (n, a)+      _ -> Nothing++-- | A read- and writable property on a UD object.+data Property e a = Property+  { propertyGet :: a -> LuaE e NumResults+  , propertySet :: Maybe (StackIndex -> a -> LuaE e a)+  , propertyDescription :: Text+  }++-- | Alias for a different property of this or of a nested object.+type Alias = [AliasIndex]++-- | Index types allowed in aliases (strings and integers)+data AliasIndex+  = StringIndex Name+  | IntegerIndex Lua.Integer++instance IsString AliasIndex where+  fromString = StringIndex . fromString++-- | A type member, either a method or a variable.+data Member e fn a+  = MemberProperty Name (Property e a)+  | MemberMethod Name fn+  | MemberAlias Name Alias++-- | Use a documented function as an object method.+methodGeneric :: Name -> fn -> Member e fn a+methodGeneric = MemberMethod++-- | A property or method which may be available in some instances but+-- not in others.+data Possible a+  = Actual a+  | Absent++-- | Declares a new read- and writable property.+property :: LuaError e+         => Name                       -- ^ property name+         -> Text                       -- ^ property description+         -> (Pusher e b, a -> b)       -- ^ how to get the property value+         -> (Peeker e b, a -> b -> a)  -- ^ how to set a new property value+         -> Member e fn a+property name desc (push, get) (peek, set) =+  possibleProperty name desc+    (push, Actual . get)+    (peek, \a b -> Actual (set a b))++-- | Declares a new read- and writable property which is not always+-- available.+possibleProperty :: LuaError e+  => Name                               -- ^ property name+  -> Text                               -- ^ property description+  -> (Pusher e b, a -> Possible b)      -- ^ how to get the property value+  -> (Peeker e b, a -> b -> Possible a) -- ^ how to set a new property value+  -> Member e fn a+possibleProperty name desc (push, get) (peek, set) = MemberProperty name $+  Property+  { propertyGet = \x -> do+      case get x of+        Actual y -> NumResults 1 <$ push y+        Absent   -> return (NumResults 0)+  , propertySet = Just $ \idx x -> do+      value  <- forcePeek $ peek idx+      case set x value of+        Actual y -> return y+        Absent   -> failLua $ "Trying to set unavailable property "+                            <> Utf8.toString (fromName name)+                            <> "."+  , propertyDescription = desc+  }++-- | Creates a read-only object property. Attempts to set the value will+-- cause an error.+readonly :: Name                 -- ^ property name+         -> Text                 -- ^ property description+         -> (Pusher e b, a -> b) -- ^ how to get the property value+         -> Member e fn a+readonly name desc (push, get) = MemberProperty name $+  Property+  { propertyGet = \x -> do+      push $ get x+      return (NumResults 1)+  , propertySet = Nothing+  , propertyDescription = desc+  }++-- | Define an alias for another, possibly nested, property.+alias :: Name  -- ^ property alias+      -> Text  -- ^ description+      -> [AliasIndex] -- ^ sequence of nested properties+      -> Member e fn a+alias name _desc = MemberAlias name++-- | Pushes the metatable for the given type to the Lua stack. Creates+-- the new table afresh on the first time it is needed, and retrieves it+-- from the registry after that.+pushUDMetatable :: LuaError e => UDTypeWithList e fn a itemtype -> LuaE e ()+pushUDMetatable ty = do+  created <- newudmetatable (udName ty)+  when created $ do+    add (metamethodName Index)    $ pushcfunction hslua_udindex_ptr+    add (metamethodName Newindex) $ pushcfunction hslua_udnewindex_ptr+    add (metamethodName Pairs)    $ pushHaskellFunction (pairsFunction ty)+    forM_ (udOperations ty) $ \(op, f) -> do+      add (metamethodName op) $ udFnPusher ty f+    add "getters" $ pushGetters ty+    add "setters" $ pushSetters ty+    add "methods" $ pushMethods ty+    add "aliases" $ pushAliases ty+    case udListSpec ty of+      Nothing -> pure ()+      Just (_, pushItem) -> do+        add "lazylisteval" $ pushHaskellFunction (lazylisteval pushItem)+  where+    add :: LuaError e => Name -> LuaE e () -> LuaE e ()+    add name op = do+      pushName name+      op+      rawset (nth 3)++-- | Retrieves a key from a Haskell-data holding userdata value.+--+-- Does the following, in order, and returns the first non-nil result:+--+--   - Checks the userdata's uservalue table for the given key;+--+--   - Looks up a @getter@ for the key and calls it with the userdata+--     and key as arguments;+--+--   - Looks up the key in the table in the @methods@ metafield.+foreign import ccall "hslobj.c &hslua_udindex"+  hslua_udindex_ptr :: FunPtr (State -> IO NumResults)++-- | Sets a new value in the userdata caching table via a setter+-- functions.+--+-- The actual assignment is performed by a setter function stored in the+-- @setter@ metafield. Throws an error if no setter function can be+-- found.+foreign import ccall "hslobj.c &hslua_udnewindex"+  hslua_udnewindex_ptr :: FunPtr (State -> IO NumResults)++-- | Sets a value in the userdata's caching table (uservalue). Takes the+-- same arguments as a @__newindex@ function.+foreign import ccall "hslobj.c &hslua_udsetter"+  hslua_udsetter_ptr :: FunPtr (State -> IO NumResults)++-- | Throws an error nothing that the given key is read-only.+foreign import ccall "hslobj.c &hslua_udreadonly"+  hslua_udreadonly_ptr :: FunPtr (State -> IO NumResults)++-- | Pushes the metatable's @getters@ field table.+pushGetters :: LuaError e => UDTypeWithList e fn a itemtype -> LuaE e ()+pushGetters ty = do+  newtable+  void $ flip Map.traverseWithKey (udProperties ty) $ \name prop -> do+    pushName name+    pushHaskellFunction $ forcePeek (peekUD ty 1) >>= propertyGet prop+    rawset (nth 3)++-- | Pushes the metatable's @setters@ field table.+pushSetters :: LuaError e => UDTypeWithList e fn a itemtype -> LuaE e ()+pushSetters ty = do+  newtable+  void $ flip Map.traverseWithKey (udProperties ty) $ \name prop -> do+    pushName name+    pushcfunction $ case propertySet prop of+      Just _  -> hslua_udsetter_ptr+      Nothing -> hslua_udreadonly_ptr+    rawset (nth 3)++-- | Pushes the metatable's @methods@ field table.+pushMethods :: LuaError e => UDTypeWithList e fn a itemtype -> LuaE e ()+pushMethods ty = do+  newtable+  void $ flip Map.traverseWithKey (udMethods ty) $ \name fn -> do+    pushName name+    udFnPusher ty fn+    rawset (nth 3)++pushAliases :: LuaError e => UDTypeWithList e fn a itemtype -> LuaE e ()+pushAliases ty = do+  newtable+  void $ flip Map.traverseWithKey (udAliases ty) $ \name propSeq -> do+    pushName name+    pushList pushAliasIndex propSeq+    rawset (nth 3)++pushAliasIndex :: Pusher e AliasIndex+pushAliasIndex = \case+  StringIndex name -> pushName name+  IntegerIndex n   -> pushIntegral n++-- | Pushes the function used to iterate over the object's key-value+-- pairs in a generic *for* loop.+pairsFunction :: forall e fn a itemtype. LuaError e+              => UDTypeWithList e fn a itemtype -> LuaE e NumResults+pairsFunction ty = do+  obj <- forcePeek $ peekUD ty (nthBottom 1)+  let pushMember = \case+        MemberProperty name prop -> do+          pushName name+          getresults <- propertyGet prop obj+          return $ getresults + 1+        MemberMethod name f -> do+          pushName name+          udFnPusher ty f+          return 2+        MemberAlias{} -> fail "aliases are not full properties"+  pushIterator pushMember $+    map (uncurry MemberProperty) (Map.toAscList (udProperties ty)) +++    map (uncurry MemberMethod) (Map.toAscList (udMethods ty))++-- | Evaluate part of a lazy list. Takes the following arguments, in+-- this order:+--+-- 1. userdata wrapping the unevalled part of the lazy list+-- 2. index of the last evaluated element+-- 3. index of the last requested element+-- 4. the caching table+lazylisteval :: forall itemtype e. LuaError e+             => Pusher e itemtype -> LuaE e NumResults+lazylisteval pushItem = do+  munevaled <- fromuserdata @[itemtype] (nthBottom 1) lazyListStateName+  mcurindex <- tointeger (nthBottom 2)+  mnewindex <- tointeger (nthBottom 3)+  case (munevaled, mcurindex, mnewindex) of+    (Just unevaled, Just curindex, Just newindex) -> do+      let numElems = fromIntegral $ max (newindex - curindex) 0+          (as, rest) = splitAt numElems unevaled+      -- put back remaining unevalled list+      _ <- putuserdata @[itemtype] (nthBottom 1) lazyListStateName rest+      -- push evaluated elements+      settop 4  -- ensure caching table is at the top of the stack+      forM_ (zip [(curindex + 1)..] as) $ \(i, a) -> do+        pushItem a+        rawseti (nthBottom 4) i+      pushName "__lazylistindex"+      pushinteger (curindex + fromIntegral (length as))+      rawset (nthBottom 4)+      return (NumResults 0)+    _ -> pure (NumResults 0)++-- | Name of the metatable used for unevaluated lazy list rema+lazyListStateName :: Name+lazyListStateName = "HsLua unevalled lazy list"++-- | Pushes a userdata value of the given type.+pushUD :: LuaError e => UDTypeWithList e fn a itemtype -> a -> LuaE e ()+pushUD ty x = do+  newhsuserdata x+  pushUDMetatable ty+  setmetatable (nth 2)+  -- add list as value in caching table+  case udListSpec ty of+    Nothing -> pure ()+    Just (toList, _) -> do+      newtable+      pushName "__lazylist"+      newhsuserdata (toList x)+      void (newudmetatable lazyListStateName)+      setmetatable (nth 2)+      rawset (nth 3)+      setuservalue (nth 2)++-- | Retrieves a userdata value of the given type.+peekUD :: LuaError e => UDTypeWithList e fn a itemtype -> Peeker e a+peekUD ty idx = do+  let name = udName ty+  x <- reportValueOnFailure name (`fromuserdata` name) idx+  liftLua $ do+    result <- getuservalue idx >>= \case+      TypeTable -> do+        pushnil+        setProperties (udProperties ty) x+      _ -> do+        return x+    pop 1          -- uservalue (caching) table+    return result++setProperties :: LuaError e => Map Name (Property e a) -> a -> LuaE e a+setProperties props x = do+  hasNext <- Unsafe.next (nth 2)+  if not hasNext+    then return x+    else ltype (nth 2) >>= \case+      TypeString -> do+        propName <- forcePeek $ peekName (nth 2)+        case Map.lookup propName props >>= propertySet of+          Nothing -> pop 1 *> setProperties props x+          Just setter -> do+            x' <- setter top x+            pop 1+            setProperties props x'+      _ -> x <$ pop 1
+ src/HsLua/ObjectOrientation/Operation.hs view
@@ -0,0 +1,142 @@+{-# LANGUAGE OverloadedStrings #-}+{-|+Module      : HsLua.ObjectOrientation.Operation+Copyright   : © 2020-2021 Albert Krewinkel+License     : MIT+Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de>++Binary and unary object operations.+-}+module HsLua.ObjectOrientation.Operation+  ( Operation (..)+  , metamethodName+  ) where++import HsLua.Core (Name)++-- | Lua metadata operation types.+data Operation+  = Add   -- ^ the addition (@+@) operation. If any operand for an+          -- addition is not a number (nor a string coercible to a+          -- number), Lua will try to call a metamethod. First, Lua will+          -- check the first operand (even if it is valid). If that+          -- operand does not define a metamethod for @__add@, then Lua+          -- will check the second operand. If Lua can find a+          -- metamethod, it calls the metamethod with the two operands+          -- as arguments, and the result of the call (adjusted to one+          -- value) is the result of the operation. Otherwise, it raises+          -- an error.+  | Sub   -- ^ the subtraction (@-@) operation. Behavior similar to the+          -- addition operation.+  | Mul   -- ^ the multiplication (@*@) operation. Behavior similar to the+          -- addition operation.+  | Div   -- ^ the division (@/@) operation. Behavior similar to the+          -- addition operation.+  | Mod   -- ^ the modulo (@%@) operation. Behavior similar to the+          -- addition operation.+  | Pow   -- ^ the exponentiation (@^@) operation. Behavior similar to the+          -- addition operation.+  | Unm   -- ^ the negation (unary @-@) operation. Behavior similar to the+          -- addition operation.+  | Idiv  -- ^ the floor division (@//@) operation. Behavior similar to+          -- the addition operation.+  | Band  -- ^ the bitwise AND (@&@) operation. Behavior similar to the+          -- addition operation, except that Lua will try a metamethod+          -- if any operand is neither an integer nor a value coercible+          -- to an integer (see §3.4.3).+  | Bor   -- ^ the bitwise OR (@|@) operation. Behavior similar to the+          -- bitwise AND operation.+  | Bxor  -- ^ the bitwise exclusive OR (binary @~@) operation. Behavior+          -- similar to the bitwise AND operation.+  | Bnot  -- ^ the bitwise NOT (unary @~@) operation. Behavior similar to+          -- the bitwise AND operation.+  | Shl   -- ^ the bitwise left shift (@<<@) operation. Behavior similar+          -- to the bitwise AND operation.+  | Shr   -- ^ the bitwise right shift (@>>@) operation. Behavior+          -- similar to the bitwise AND operation.+  | Concat+          -- ^ the concatenation (@..@) operation. Behavior similar to+          -- the addition operation, except that Lua will try a+          -- metamethod if any operand is neither a string nor a number+          -- (which is always coercible to a string).+  | Len   -- ^ the length (@#@) operation. If the object is not a string,+          -- Lua will try its metamethod. If there is a metamethod, Lua+          -- calls it with the object as argument, and the result of the+          -- call (always adjusted to one value) is the result of the+          -- operation. If there is no metamethod but the object is a+          -- table, then Lua uses the table length operation (see+          -- §3.4.7). Otherwise, Lua raises an error.+  | Eq    -- ^ the equal (@==@) operation. Behavior similar to the+          -- addition operation, except that Lua will try a metamethod+          -- only when the values being compared are either both tables+          -- or both full userdata and they are not primitively equal.+          -- The result of the call is always converted to a boolean.+  | Lt    -- ^ the less than (@<@) operation. Behavior similar to the+          -- addition operation, except that Lua will try a metamethod+          -- only when the values being compared are neither both+          -- numbers nor both strings. The result of the call is always+          -- converted to a boolean.+  | Le    -- ^ the less equal (@<=@) operation. Unlike other operations,+          -- the less-equal operation can use two different events.+          -- First, Lua looks for the @__le@ metamethod in both+          -- operands, like in the less than operation. If it cannot+          -- find such a metamethod, then it will try the @__lt@+          -- metamethod, assuming that a <= b is equivalent to not (b <+          -- a). As with the other comparison operators, the result is+          -- always a boolean. (This use of the @__lt@ event can be+          -- removed in future versions; it is also slower than a real+          -- __le metamethod.)+  | Index -- ^ The indexing access operation @table[key]@. This event+          -- happens when table is not a table or when key is not+          -- present in table. The metamethod is looked up in table.+  | Newindex+          -- ^ The indexing assignment @table[key] = value@. Like the+          -- index event, this event happens when table is not a table+          -- or when key is not present in table. The metamethod is+          -- looked up in table.+  | Call  -- ^ The call operation @func(args)@. This event happens when+          -- Lua tries to call a non-function value (that is, func is+          -- not a function). The metamethod is looked up in func. If+          -- present, the metamethod is called with func as its first+          -- argument, followed by the arguments of the original call+          -- (args). All results of the call are the result of the+          -- operation. (This is the only metamethod that allows+          -- multiple results.)+  | Tostring+          -- ^ The operation used to create a string representation of+          -- the object.+  | Pairs -- ^ the operation of iterating over the object's key-value+          -- pairs.+  | CustomOperation Name+          -- ^ a custom operation, with the metamethod name as+          -- parameter.+  deriving (Eq, Ord, Show)++-- | Returns the metamethod name used to control this operation.+metamethodName :: Operation -> Name+metamethodName = \case+  Add      -> "__add"+  Sub      -> "__sub"+  Mul      -> "__mul"+  Div      -> "__div"+  Mod      -> "__mod"+  Pow      -> "__pow"+  Unm      -> "__unm"+  Idiv     -> "__idiv"+  Band     -> "__band"+  Bor      -> "__bor"+  Bxor     -> "__bxor"+  Bnot     -> "__bnot"+  Shl      -> "__shl"+  Shr      -> "__shr"+  Concat   -> "__concat"+  Len      -> "__len"+  Eq       -> "__eq"+  Lt       -> "__lt"+  Le       -> "__le"+  Index    -> "__index"+  Newindex -> "__newindex"+  Call     -> "__call"+  Tostring -> "__tostring"+  Pairs    -> "__pairs"+  CustomOperation x -> x
+ test/HsLua/ObjectOrientationTests.hs view
@@ -0,0 +1,373 @@+{-# LANGUAGE LambdaCase        #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications  #-}+{-|+Module      : HsLua.ObjectOrientationTests+Copyright   : © 2007–2012 Gracjan Polak;+              © 2012–2016 Ömer Sinan Ağacan;+              © 2017-2021 Albert Krewinkel+License     : MIT+Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de>+Stability   : beta+Portability : non-portable (depends on GHC)++Test that conversions from and to the Lua stack are isomorphisms.+-}+module HsLua.ObjectOrientationTests (tests) where++import HsLua.Core+import HsLua.ObjectOrientation+import HsLua.Marshalling+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HsLua ((=:), shouldBeResultOf, shouldBeErrorMessageOf)+import qualified Data.ByteString.Char8 as Char8++-- | Tests for HsLua object orientation.+tests :: TestTree+tests = testGroup "Object Orientation"+  [ testGroup "Sample product type"+    [ "tostring" =:+      "Foo 7 \"seven\"" `shouldBeResultOf` do+        openlibs+        pushUD typeFoo $ Foo 7 "seven"+        setglobal "foo"+        _ <- dostring "return tostring(foo)"+        forcePeek $ peekText top++    , "show" =:+      "Foo 5 \"five\"" `shouldBeResultOf` do+        openlibs+        pushUD typeFoo $ Foo 5 "five"+        setglobal "foo"+        _ <- dostring "return foo:show()"+        forcePeek $ peekText top++    , "peek" =:+      Foo 37 "ananas" `shouldBeResultOf` do+        pushUD typeFoo $ Foo 37 "ananas"+        forcePeek $ peekUD typeFoo top++    , "unknown properties have value `nil`" =:+      TypeNil `shouldBeResultOf` do+        openlibs+        pushUD typeFoo $ Foo (-1) "a"+        setglobal "foo"+        dostring "return foo.does_not_exist" >>= \case+          OK -> ltype top+          _ -> throwErrorAsException++    , "get number" =:+      (-1) `shouldBeResultOf` do+        openlibs+        pushUD typeFoo $ Foo (-1) "a"+        setglobal "foo"+        dostring "return foo.num" >>= \case+          OK -> forcePeek $ peekIntegral @Int top+          _ -> throwErrorAsException++    , "get number twice" =:+      8 `shouldBeResultOf` do+        openlibs+        pushUD typeFoo $ Foo 4 "d"+        setglobal "foo"+        dostring "return foo.num + foo.num" >>= \case+          OK -> forcePeek $ peekIntegral @Int top+          _ -> throwErrorAsException++    , "modify number" =:+      Foo (-1) "a" `shouldBeResultOf` do+        openlibs+        pushUD typeFoo $ Foo 1 "a"+        setglobal "foo"+        OK <- dostring "foo.num = -1"+        TypeUserdata <- getglobal "foo"+        forcePeek $ peekUD typeFoo top++    , "get string" =:+      "lint" `shouldBeResultOf` do+        openlibs+        pushUD typeFoo $ Foo 0 "lint"+        setglobal "foo"+        dostring "return foo.str" >>= \case+          OK -> forcePeek $ peekText top+          _ -> throwErrorAsException++    , "cannot change readonly string" =:+      "'str' is a read-only property." `shouldBeErrorMessageOf` do+        openlibs+        pushUD typeFoo $ Foo 2 "b"+        setglobal "foo"+        ErrRun <- dostring "foo.str = 'c'"+        throwErrorAsException :: Lua ()++    , "Can peek after getting read-only property" =:+      Foo 144 "gros" `shouldBeResultOf` do+        openlibs+        pushUD typeFoo $ Foo 144 "gros"+        setglobal "foo"+        OK <- dostring "bar = foo.str"+        _ <- getglobal "foo"+        forcePeek $ peekUD typeFoo top++    , "cannot change unknown property" =:+      "Cannot set unknown property." `shouldBeErrorMessageOf` do+        openlibs+        pushUD typeFoo $ Foo 11 "eleven"+        setglobal "foo"+        ErrRun <- dostring "foo.does_not_exist = nil"+        throwErrorAsException :: Lua ()++    , "pairs iterates over properties" =:+      ["num", "5", "str", "echo", "show", "function"] `shouldBeResultOf` do+        openlibs+        pushUD typeFoo $ Foo 5 "echo"+        setglobal "echo"+        OK <- dostring $ Char8.unlines+          [ "local result = {}"+          , "for k, v in pairs(echo) do"+          , "  table.insert(result, k)"+          , "  table.insert("+          , "    result,"+          , "    type(v) == 'function' and 'function' or tostring(v)"+          , "  )"+          , "end"+          , "return result"+          ]+        forcePeek $ peekList peekText top+    ]++  , testGroup "Bar type"+    [ "Modifying a table modifies the object" =:+      Bar [7, 8] `shouldBeResultOf` do+        openlibs+        pushUD typeBar $ Bar [7]+        setglobal "bar"+        OK <- dostring "table.insert(bar.nums, 8)"+        _ <- getglobal "bar"+        forcePeek $ peekUD typeBar top++    , "Use integer index in alias" =:+      42 `shouldBeResultOf` do+        openlibs+        pushUD typeBar $ Bar [42, 5, 23]+        setglobal "bar"+        OK <- dostring "return bar.first"+        forcePeek $ peekIntegral @Int top+    ]++  , testGroup "lazy list"+    [ "Access an element of a lazy list stub" =:+      3 `shouldBeResultOf` do+        openlibs+        pushUD typeLazyIntList $ LazyIntList [1,1,2,3,5,8]+        setglobal "list"+        _ <- dostring "return (list[4])"+        forcePeek $ peekIntegral @Int top++    , "Remaining list is not evaluated" =:+      2 `shouldBeResultOf` do+        openlibs+        pushUD typeLazyIntList $ LazyIntList [1,1,2, Prelude.error "CRASH!"]+        setglobal "list"+        _ <- dostring "return (list[3])"+        forcePeek $ peekIntegral @Int top++    , "Out-of-bounds indices return nil" =:+      (TypeNil, TypeNil) `shouldBeResultOf` do+        openlibs+        pushUD typeLazyIntList $ LazyIntList [1,4,9,16]+        setglobal "list"+        _ <- dostring "return list[0], list[5]"+        (,) <$> ltype (nth 1) <*> ltype (nth 2)++    , "List is read-only" =:+      (ErrRun, "Cannot set a numerical value.") `shouldBeResultOf` do+        openlibs+        pushUD typeLazyIntList $ LazyIntList [1,4,9,16]+        setglobal "list"+        statusCode <- dostring "list[1] = 2"+        err <- forcePeek $ peekString top+        pure (statusCode, err)+    ]++  , testGroup "possible properties"+    [ "tostring Quux" =:+      "Quux 11 \"eleven\"" `shouldBeResultOf` do+        openlibs+        pushUD typeQux $ Quux 11 "eleven"+        setglobal "quux"+        _ <- dostring "return tostring(quux)"+        forcePeek $ peekText top+    , "show Quux" =:+      "Quux 11 \"eleven\"" `shouldBeResultOf` do+        openlibs+        pushUD typeQux $ Quux 11 "eleven"+        setglobal "quux"+        _ <- dostring "return quux:show()"+        forcePeek $ peekText top++    , "access Quux.num" =:+      "12" `shouldBeResultOf` do+        openlibs+        pushUD typeQux $ Quux 12 "twelve"+        setglobal "quux"+        _ <- dostring "return quux.num"+        forcePeek $ peekText top++    , "access Quux.str" =:+      "thirteen!" `shouldBeResultOf` do+        openlibs+        pushUD typeQux $ Quux 13 "thirteen"+        setglobal "quux"+        _ <- dostring "return quux.num"+        _ <- dostring "quux.str = quux.str .. '!'; return quux.str"+        forcePeek $ peekText top++    , testGroup "alias"+      [ "read subelement via alias" =:+        13.37 `shouldBeResultOf` do+          openlibs+          pushUD typeQux $ Quuz (Point 13.37 0) undefined+          setglobal "quuz"+          _ <- dostring "return quuz.x"+          forcePeek $ peekRealFloat @Double top+      , "set subelement via alias" =:+        Point 42 1 `shouldBeResultOf` do+          openlibs+          pushUD typeQux $ Quuz (Point 1 1) undefined+          setglobal "quuz"+          _ <- dostring "quuz.x = 42; return quuz.point"+          -- msg <- forcePeek $ peekString top+          -- liftIO $ putStrLn msg+          forcePeek $ peekPoint top+      ]+    ]+  ]++deftype :: LuaError e+        => Name                              -- ^ type name+        -> [(Operation, HaskellFunction e)]  -- ^ operations+        -> [Member e (HaskellFunction e) a]  -- ^ methods+        -> UDType e (HaskellFunction e) a+deftype = deftypeGeneric pushHaskellFunction++deftype' :: LuaError e+         => Name                  -- ^ type name+         -> [(Operation, HaskellFunction e)]  -- ^ operations+         -> [Member e (HaskellFunction e) a]  -- ^ methods+         -> Maybe (ListSpec e a itemtype)  -- ^ list access+         -> UDTypeWithList e (HaskellFunction e) a itemtype+deftype' = deftypeGeneric' pushHaskellFunction++-- | Define a (meta) operation on a type.+operation :: Operation -> HaskellFunction e -> (Operation, HaskellFunction e)+operation = (,)++-- | Sample product type+data Foo = Foo Int String+  deriving (Eq, Show)++-- | Specify behavior of Foo values in Lua.+typeFoo :: LuaError e => UDType e (HaskellFunction e) Foo+typeFoo = deftype "Foo"+  [ operation Tostring show' ]+  [ property "num" "some number"+      (pushIntegral, \(Foo n _) -> n)+      (peekIntegral, \(Foo _ s) n -> Foo n s)+  , readonly "str" "some string" (pushString, \(Foo _ s) -> s)+  , methodGeneric "show" show'+  ]+  where+    show' = do+      foo <- forcePeek $ peekUD typeFoo (nthBottom 1)+      pushString (show foo)+      return (NumResults 1)+++newtype Bar = Bar [Int]+  deriving (Eq, Show)++typeBar :: LuaError e => UDType e (HaskellFunction e) Bar+typeBar = deftype "Bar" []+  [ property "nums" "some numbers"+    (pushList pushIntegral, \(Bar nums) -> nums)+    (peekList peekIntegral, \(Bar _) nums -> Bar nums)+  , alias "first" "first element" ["nums", IntegerIndex 1]+  ]++newtype LazyIntList = LazyIntList { fromLazyIntList :: [Int] }+  deriving (Eq, Show)++typeLazyIntList :: LuaError e+                => UDTypeWithList e (HaskellFunction e) LazyIntList Int+typeLazyIntList = deftype' "LazyIntList"+  [ operation Tostring $ do+      lazyList <- forcePeek $ peekUD typeLazyIntList (nthBottom 1)+      pushString (show lazyList)+      return (NumResults 1)+  ]+  []+  (Just (fromLazyIntList, pushIntegral))++--+-- Sample sum type+--+data Qux+  = Quux Int String+  | Quuz Point Int+  deriving (Eq, Show)++data Point = Point Double Double+  deriving (Eq, Show)++pushPoint :: LuaError e => Pusher e Point+pushPoint (Point x y) = do+  newtable+  pushName "x" *> pushRealFloat x *> rawset (nth 3)+  pushName "y" *> pushRealFloat y *> rawset (nth 3)++peekPoint :: LuaError e => Peeker e Point+peekPoint idx = do+  x <- peekFieldRaw peekRealFloat "x" idx+  y <- peekFieldRaw peekRealFloat "y" idx+  return $ x `seq` y `seq` Point x y++showQux :: LuaError e => HaskellFunction e+showQux = do+  qux <- forcePeek $ peekQux (nthBottom 1)+  pushString $ show qux+  return (NumResults 1)++peekQux :: LuaError e => Peeker e Qux+peekQux = peekUD typeQux++typeQux :: LuaError e => UDType e (HaskellFunction e) Qux+typeQux = deftype "Qux"+  [ operation Tostring showQux ]+  [ methodGeneric "show" showQux+  , property "num" "some number"+      (pushIntegral, \case+          Quux n _ -> n+          Quuz _ n -> n)+      (peekIntegral, \case+          Quux _ s -> (`Quux` s)+          Quuz d _ -> Quuz d)++  , possibleProperty "str" "a string in Quux"+    (pushString, \case+        Quux _ s -> Actual s+        Quuz {}  -> Absent)+    (peekString, \case+        Quux n _ -> Actual . Quux n+        Quuz {}  -> const Absent)++  , possibleProperty "point" "a point in Quuz"+    (pushPoint, \case+        Quuz p _ -> Actual p+        Quux {}  -> Absent)+    (peekPoint, \case+        Quuz _ n -> Actual . (`Quuz` n)+        Quux {}  -> const Absent)++  , alias "x" "The x coordinate of a point in Quuz" ["point", "x"]+  ]
+ test/test-hslua-objectorientation.hs view
@@ -0,0 +1,24 @@+{-|+Module      : Main+Copyright   : © 2007–2012 Gracjan Polak;+              © 2012–2016 Ömer Sinan Ağacan;+              © 2017-2021 Albert Krewinkel+License     : MIT+Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de>+Stability   : beta+Portability : non-portable (depends on GHC)++Test marshaling/unmarshaling from and to the Lua stack.+-}+module Main (main) where++import Test.Tasty (TestTree, defaultMain, testGroup)++import qualified HsLua.ObjectOrientationTests++main :: IO ()+main = defaultMain $ testGroup "hslua-objectorientation" tests++-- | HSpec tests+tests :: [TestTree]+tests = [ HsLua.ObjectOrientationTests.tests ]