Script 'mail_helper' called by obssrc
Hello community,
here is the log from the commit of package ghc-hslua-objectorientation for
openSUSE:Factory checked in at 2023-04-14 13:13:06
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-hslua-objectorientation (Old)
and /work/SRC/openSUSE:Factory/.ghc-hslua-objectorientation.new.19717
(New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-hslua-objectorientation"
Fri Apr 14 13:13:06 2023 rev:5 rq:1079193 version:2.3.0
Changes:
--------
---
/work/SRC/openSUSE:Factory/ghc-hslua-objectorientation/ghc-hslua-objectorientation.changes
2023-04-04 21:20:49.981337193 +0200
+++
/work/SRC/openSUSE:Factory/.ghc-hslua-objectorientation.new.19717/ghc-hslua-objectorientation.changes
2023-04-14 13:13:18.243641382 +0200
@@ -1,0 +2,9 @@
+Thu Apr 13 12:06:26 UTC 2023 - Peter Simons <[email protected]>
+
+- Update hslua-objectorientation to version 2.3.0.
+ Upstream has edited the change log file since the last release in
+ a non-trivial way, i.e. they did more than just add a new entry
+ at the top. You can review the file at:
+
http://hackage.haskell.org/package/hslua-objectorientation-2.3.0/src/CHANGELOG.md
+
+-------------------------------------------------------------------
Old:
----
hslua-objectorientation-2.2.1.tar.gz
New:
----
hslua-objectorientation-2.3.0.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-hslua-objectorientation.spec ++++++
--- /var/tmp/diff_new_pack.wqH6EZ/_old 2023-04-14 13:13:19.439648221 +0200
+++ /var/tmp/diff_new_pack.wqH6EZ/_new 2023-04-14 13:13:19.443648244 +0200
@@ -20,7 +20,7 @@
%global pkgver %{pkg_name}-%{version}
%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 2.2.1
+Version: 2.3.0
Release: 0
Summary: Object orientation tools for HsLua
License: MIT
@@ -39,6 +39,8 @@
BuildRequires: ghc-hslua-core-prof
BuildRequires: ghc-hslua-marshalling-devel
BuildRequires: ghc-hslua-marshalling-prof
+BuildRequires: ghc-hslua-typing-devel
+BuildRequires: ghc-hslua-typing-prof
BuildRequires: ghc-mtl-devel
BuildRequires: ghc-mtl-prof
BuildRequires: ghc-rpm-macros
++++++ hslua-objectorientation-2.2.1.tar.gz ->
hslua-objectorientation-2.3.0.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hslua-objectorientation-2.2.1/CHANGELOG.md
new/hslua-objectorientation-2.3.0/CHANGELOG.md
--- old/hslua-objectorientation-2.2.1/CHANGELOG.md 2001-09-09
03:46:40.000000000 +0200
+++ new/hslua-objectorientation-2.3.0/CHANGELOG.md 2001-09-09
03:46:40.000000000 +0200
@@ -2,6 +2,43 @@
`hslua-objectorientation` uses [PVP Versioning][].
+## hslua-objectorientation-2.3.0
+
+Released 2023-03-13.
+
+- Export all constructors and functions of type `Property`.
+
+- Renamed `peekUD` to `peekUDGeneric` and `pushUD` to
+ `pushUDGeneric`. Functions with the old names are now
+ now defined hslua-packaging.
+
+- Hook for udtype metatable initializer. The function
+ `pushUDGeneric` takes an additional `hook` parameter. The hook
+ operation can be used to perform additional setup operations,
+ e.g., for documentation.
+
+ The old `pushUD` function can be recovered with
+
+ pushUD = pushUDGeneric (\_ -> pure ())
+
+ The `hslua-packaging` now exports a `pushUD` functions that is
+ specialized to documented types.
+
+- Export new function `initTypeGeneric`: The function ensures
+ that a type's metatable is initialized and available from the
+ registry. Just like with `pushUDGeneric`, a hook can be used
+ to augment the initialization.
+
+- Type info for properties: Properties are amended with
+ information on the property's type. The functions `property`,
+ `possibleProperty`, and `readonly` each now come with typed
+ version `property'`, `possibleProperty'`, and `readonly`'.
+ This allows to specify the type of a property value.
+
+- Functions for object typing info: The functions `udDocs` and
+ `udTypeSpec` are added, enabling the generation of typing
+ information for UDType objects.
+
## hslua-objectorientation-2.2.1
Released 2022-06-19.
@@ -24,7 +61,7 @@
## hslua-objectorientation-2.1.0
-Released 29-01-2022.
+Released 2022-01-29.
- Allow integers as aliases: Aliases can now be of type
`AliasIndex`, so integers can now be defined as aliases for
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hslua-objectorientation-2.2.1/LICENSE
new/hslua-objectorientation-2.3.0/LICENSE
--- old/hslua-objectorientation-2.2.1/LICENSE 2001-09-09 03:46:40.000000000
+0200
+++ new/hslua-objectorientation-2.3.0/LICENSE 2001-09-09 03:46:40.000000000
+0200
@@ -1,7 +1,7 @@
Copyright © 1994-2022 Lua.org, PUC-Rio.
Copyright © 2007-2012 Gracjan Polak
Copyright © 2012-2015 Ãmer Sinan AÄacan
-Copyright © 2016-2022 Albert Krewinkel
+Copyright © 2016-2023 Albert Krewinkel
Permission is hereby granted, free of charge, to any person obtaining a
copy of this software and associated documentation files (the
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/hslua-objectorientation-2.2.1/hslua-objectorientation.cabal
new/hslua-objectorientation-2.3.0/hslua-objectorientation.cabal
--- old/hslua-objectorientation-2.2.1/hslua-objectorientation.cabal
2001-09-09 03:46:40.000000000 +0200
+++ new/hslua-objectorientation-2.3.0/hslua-objectorientation.cabal
2001-09-09 03:46:40.000000000 +0200
@@ -1,6 +1,6 @@
cabal-version: 2.2
name: hslua-objectorientation
-version: 2.2.1
+version: 2.3.0
synopsis: Object orientation tools for HsLua
description: Expose Haskell objects to Lua with an object oriented
interface.
@@ -9,20 +9,19 @@
license: MIT
license-file: LICENSE
author: Albert Krewinkel
-maintainer: [email protected]
-copyright: © 2021-2022 Albert Krewinkel
+maintainer: [email protected]
+copyright: © 2021-2023 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
+tested-with: GHC == 8.4.4
, GHC == 8.6.5
, GHC == 8.8.4
, GHC == 8.10.7
, GHC == 9.0.2
- , GHC == 9.2.3
+ , GHC == 9.2.5
+ , GHC == 9.4.4
source-repository head
type: git
@@ -31,12 +30,13 @@
common common-options
default-language: Haskell2010
- build-depends: base >= 4.8 && < 5
+ build-depends: base >= 4.11 && < 5
, bytestring >= 0.10.2 && < 0.12
, containers >= 0.5.9 && < 0.7
, exceptions >= 0.8 && < 0.11
- , hslua-core >= 2.2.1 && < 2.3
- , hslua-marshalling >= 2.2.1 && < 2.3
+ , hslua-core >= 2.2.1 && < 2.4
+ , hslua-marshalling >= 2.2.1 && < 2.4
+ , hslua-typing >= 0.1 && < 0.2
, mtl >= 2.2 && < 2.4
, text >= 1.2 && < 2.1
ghc-options: -Wall
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/hslua-objectorientation-2.2.1/src/HsLua/ObjectOrientation/Operation.hs
new/hslua-objectorientation-2.3.0/src/HsLua/ObjectOrientation/Operation.hs
--- old/hslua-objectorientation-2.2.1/src/HsLua/ObjectOrientation/Operation.hs
2001-09-09 03:46:40.000000000 +0200
+++ new/hslua-objectorientation-2.3.0/src/HsLua/ObjectOrientation/Operation.hs
2001-09-09 03:46:40.000000000 +0200
@@ -1,9 +1,9 @@
{-# LANGUAGE OverloadedStrings #-}
{-|
Module : HsLua.ObjectOrientation.Operation
-Copyright : © 2020-2022 Albert Krewinkel
+Copyright : © 2020-2023 Albert Krewinkel
License : MIT
-Maintainer : Albert Krewinkel <[email protected]>
+Maintainer : Albert Krewinkel <[email protected]>
Binary and unary object operations.
-}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/hslua-objectorientation-2.2.1/src/HsLua/ObjectOrientation.hs
new/hslua-objectorientation-2.3.0/src/HsLua/ObjectOrientation.hs
--- old/hslua-objectorientation-2.2.1/src/HsLua/ObjectOrientation.hs
2001-09-09 03:46:40.000000000 +0200
+++ new/hslua-objectorientation-2.3.0/src/HsLua/ObjectOrientation.hs
2001-09-09 03:46:40.000000000 +0200
@@ -1,13 +1,12 @@
-{-# LANGUAGE CPP #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-|
Module : HsLua.ObjectOrientation
-Copyright : © 2021-2022 Albert Krewinkel
+Copyright : © 2021-2023 Albert Krewinkel
License : MIT
-Maintainer : Albert Krewinkel <[email protected]>
+Maintainer : Albert Krewinkel <[email protected]>
This module provides types and functions to use Haskell values as
userdata objects in Lua. These objects wrap a Haskell value and provide
@@ -19,18 +18,30 @@
module HsLua.ObjectOrientation
( UDType
, UDTypeWithList (..)
+ -- * Defining types
, deftypeGeneric
, deftypeGeneric'
+ -- ** Methods
, methodGeneric
+ -- ** Properties
, property
+ , property'
, possibleProperty
+ , possibleProperty'
, readonly
+ , readonly'
+ -- ** Aliases
, alias
- , peekUD
- , pushUD
+ -- * Marshaling
+ , peekUDGeneric
+ , pushUDGeneric
+ , initTypeGeneric
+ -- * Type docs
+ , udDocs
+ , udTypeSpec
-- * Helper types for building
, Member
- , Property
+ , Property (..)
, Operation (..)
, ListSpec
, Possible (..)
@@ -41,9 +52,6 @@
import Control.Monad ((<$!>), forM_, void, when)
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)
@@ -51,6 +59,7 @@
import HsLua.Core as Lua
import HsLua.Marshalling
import HsLua.ObjectOrientation.Operation
+import HsLua.Typing ( TypeDocs (..), TypeSpec (..), anyType, userdataType )
import qualified Data.Map.Strict as Map
import qualified HsLua.Core.Unsafe as Unsafe
import qualified HsLua.Core.Utf8 as Utf8
@@ -132,6 +141,7 @@
{ propertyGet :: a -> LuaE e NumResults
, propertySet :: Maybe (StackIndex -> a -> LuaE e a)
, propertyDescription :: Text
+ , propertyType :: TypeSpec
}
-- | Alias for a different property of this or of a nested object.
@@ -162,6 +172,19 @@
= Actual a
| Absent
+-- | Declares a new read- and writable typed property.
+property' :: LuaError e
+ => Name -- ^ property name
+ -> TypeSpec -- ^ property type
+ -> 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 typespec desc (push, get) (peek, set) =
+ possibleProperty' name typespec desc
+ (push, Actual . get)
+ (peek, \a b -> Actual (set a b))
+
-- | Declares a new read- and writable property.
property :: LuaError e
=> Name -- ^ property name
@@ -182,7 +205,19 @@
-> (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 $
+possibleProperty name = possibleProperty' name anyType
+
+-- | Declares a new read- and writable property which is not always
+-- available.
+possibleProperty' :: LuaError e
+ => Name -- ^ property name
+ -> TypeSpec -- ^ type of the property value
+ -> 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 typespec desc (push, get) (peek, set) =
+ MemberProperty name $
Property
{ propertyGet = \x -> do
case get x of
@@ -195,24 +230,35 @@
Absent -> failLua $ "Trying to set unavailable property "
<> Utf8.toString (fromName name)
<> "."
+ , propertyType = typespec
, 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 $
+readonly' :: Name -- ^ property name
+ -> TypeSpec -- ^ property type
+ -> Text -- ^ property description
+ -> (Pusher e b, a -> b) -- ^ how to get the property value
+ -> Member e fn a
+readonly' name typespec desc (push, get) = MemberProperty name $
Property
{ propertyGet = \x -> do
push $ get x
return (NumResults 1)
, propertySet = Nothing
+ , propertyType = typespec
, 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 = readonly' name anyType
+
-- | Define an alias for another, possibly nested, property.
alias :: AliasIndex -- ^ property alias
-> Text -- ^ description
@@ -220,11 +266,41 @@
-> Member e fn a
alias name _desc = MemberAlias name
+-- | Ensures that the type has been fully initialized, i.e., that all
+-- metatables have been created and stored in the registry. Returns the
+-- name of the initialized type.
+--
+-- The @hook@ can be used to perform additional setup operations. The
+-- function is called as the last step after the type metatable has been
+-- initialized: the fully initialized metatable will be at the top of
+-- the stack at that point. Note that the hook will /not/ be called if
+-- the type's metatable already existed before this function was
+-- invoked.
+initTypeGeneric :: LuaError e
+ => (UDTypeWithList e fn a itemtype -> LuaE e ())
+ -> UDTypeWithList e fn a itemtype
+ -> LuaE e Name
+initTypeGeneric hook ty = do
+ pushUDMetatable hook ty
+ pop 1
+ return (udName ty)
+
-- | 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
+--
+--
+-- A @hook@ can be used to perform additional setup operations. The
+-- function is called as the last step after the type metatable has been
+-- initialized: the fully initialized metatable will be at the top of
+-- the stack at that point. Note that the hook will /not/ be called if
+-- the type's metatable already existed before this function was
+-- invoked.
+pushUDMetatable :: LuaError e
+ => (UDTypeWithList e fn a itemtype -> LuaE e ()) -- ^ @hook@
+ -> UDTypeWithList e fn a itemtype
+ -> LuaE e ()
+pushUDMetatable hook ty = do
created <- newudmetatable (udName ty)
when created $ do
add (metamethodName Index) $ pushcfunction hslua_udindex_ptr
@@ -240,6 +316,7 @@
Nothing -> pure ()
Just ((pushItem, _), _) -> do
add "lazylisteval" $ pushHaskellFunction (lazylisteval pushItem)
+ hook ty
where
add :: LuaError e => Name -> LuaE e () -> LuaE e ()
add name op = do
@@ -284,7 +361,7 @@
newtable
void $ flip Map.traverseWithKey (udProperties ty) $ \name prop -> do
pushName name
- pushHaskellFunction $ forcePeek (peekUD ty 1) >>= propertyGet prop
+ pushHaskellFunction $ forcePeek (peekUDGeneric ty 1) >>= propertyGet prop
rawset (nth 3)
-- | Pushes the metatable's @setters@ field table.
@@ -325,7 +402,7 @@
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)
+ obj <- forcePeek $ peekUDGeneric ty (nthBottom 1)
let pushMember = \case
MemberProperty name prop -> do
pushName name
@@ -383,10 +460,14 @@
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
+pushUDGeneric :: LuaError e
+ => (UDTypeWithList e fn a itemtype -> LuaE e ()) -- ^ push docs
+ -> UDTypeWithList e fn a itemtype -- ^ userdata type
+ -> a -- ^ value to push
+ -> LuaE e ()
+pushUDGeneric pushDocs ty x = do
newhsuserdatauv x 1
- pushUDMetatable ty
+ pushUDMetatable pushDocs ty
setmetatable (nth 2)
-- add list as value in caching table
case udListSpec ty of
@@ -401,8 +482,8 @@
void (setiuservalue (nth 2) 1)
-- | Retrieves a userdata value of the given type.
-peekUD :: LuaError e => UDTypeWithList e fn a itemtype -> Peeker e a
-peekUD ty idx = do
+peekUDGeneric :: LuaError e => UDTypeWithList e fn a itemtype -> Peeker e a
+peekUDGeneric ty idx = do
let name = udName ty
x <- reportValueOnFailure name (`fromuserdata` name) idx
(`lastly` pop 1) $ liftLua (getiuservalue idx 1) >>= \case
@@ -465,3 +546,21 @@
(y:) <$!> itemsAfter (i + 1)
else getLazyList
itemsAfter 1
+
+--
+-- Typing
+--
+
+-- | Returns documentation for this type.
+udDocs :: UDTypeWithList e fn a itemtype
+ -> TypeDocs
+udDocs ty = TypeDocs
+ { typeDescription = mempty
+ , typeSpec = userdataType
+ , typeRegistry = Just (udName ty)
+ }
+
+-- | Type specifier for a UDType
+udTypeSpec :: UDTypeWithList e fn a itemtype
+ -> TypeSpec
+udTypeSpec = NamedType . udName
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/hslua-objectorientation-2.2.1/test/HsLua/ObjectOrientationTests.hs
new/hslua-objectorientation-2.3.0/test/HsLua/ObjectOrientationTests.hs
--- old/hslua-objectorientation-2.2.1/test/HsLua/ObjectOrientationTests.hs
2001-09-09 03:46:40.000000000 +0200
+++ new/hslua-objectorientation-2.3.0/test/HsLua/ObjectOrientationTests.hs
2001-09-09 03:46:40.000000000 +0200
@@ -5,9 +5,9 @@
Module : HsLua.ObjectOrientationTests
Copyright : © 2007â2012 Gracjan Polak;
© 2012â2016 Ãmer Sinan AÄacan;
- © 2017-2022 Albert Krewinkel
+ © 2017-2023 Albert Krewinkel
License : MIT
-Maintainer : Albert Krewinkel <[email protected]>
+Maintainer : Albert Krewinkel <[email protected]>
Stability : beta
Portability : non-portable (depends on GHC)
@@ -18,6 +18,7 @@
import HsLua.Core
import HsLua.ObjectOrientation
import HsLua.Marshalling
+import HsLua.Typing
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HsLua ((=:), shouldBeResultOf, shouldBeErrorMessageOf)
import qualified Data.ByteString.Char8 as Char8
@@ -45,7 +46,7 @@
, "peek" =:
Foo 37 "ananas" `shouldBeResultOf` do
pushUD typeFoo $ Foo 37 "ananas"
- forcePeek $ peekUD typeFoo top
+ forcePeek $ peekUDGeneric typeFoo top
, "unknown properties have value `nil`" =:
TypeNil `shouldBeResultOf` do
@@ -81,7 +82,7 @@
setglobal "foo"
OK <- dostring "foo.num = -1"
TypeUserdata <- getglobal "foo"
- forcePeek $ peekUD typeFoo top
+ forcePeek $ peekUDGeneric typeFoo top
, "get string" =:
"lint" `shouldBeResultOf` do
@@ -107,7 +108,7 @@
setglobal "foo"
OK <- dostring "bar = foo.str"
_ <- getglobal "foo"
- forcePeek $ peekUD typeFoo top
+ forcePeek $ peekUDGeneric typeFoo top
, "cannot change unknown property" =:
"Cannot set unknown property." `shouldBeErrorMessageOf` do
@@ -157,7 +158,7 @@
setglobal "bar"
OK <- dostring "table.insert(bar.nums, 8)"
_ <- getglobal "bar"
- forcePeek $ peekUD typeBar top
+ forcePeek $ peekUDGeneric typeBar top
, "Use integer index in alias" =:
42 `shouldBeResultOf` do
@@ -168,6 +169,27 @@
forcePeek $ peekIntegral @Int top
]
+ , testGroup "initType"
+ [ "type table is added to the registry" =:
+ TypeTable `shouldBeResultOf` do
+ openlibs
+ name <- initTypeGeneric (\_ -> pure ()) typeBar
+ getfield registryindex name
+
+ , "type table is not in registry when uninitialized" =:
+ TypeNil `shouldBeResultOf` do
+ openlibs
+ getfield registryindex (udName (typeBar @HsLua.Core.Exception))
+
+ , "initializing does not affect the stack" =:
+ 0 `shouldBeResultOf` do
+ openlibs
+ before <- gettop
+ _ <- initTypeGeneric (\_ -> pure ()) typeBar
+ after <- gettop
+ return $ after - before
+ ]
+
, testGroup "lazy list"
[ "Access an element of a lazy list stub" =:
3 `shouldBeResultOf` do
@@ -215,7 +237,7 @@
pushUD typeLazyIntList $ LazyIntList [9..17]
setglobal "ninetofive"
_ <- dostring "assert(ninetofive[3] == 11); return ninetofive"
- forcePeek $ peekUD typeLazyIntList top
+ forcePeek $ peekUDGeneric typeLazyIntList top
, "List is writable" =:
LazyIntList [1, 4, 9, 16] `shouldBeResultOf` do
@@ -223,7 +245,7 @@
pushUD typeLazyIntList $ LazyIntList [0,4,9,16]
setglobal "list"
OK <- dostring "list[1] = 1; return list"
- forcePeek $ peekUD typeLazyIntList top
+ forcePeek $ peekUDGeneric typeLazyIntList top
, "List can be extended" =:
LazyIntList [1, 4, 9, 16, 25] `shouldBeResultOf` do
@@ -231,7 +253,7 @@
pushUD typeLazyIntList $ LazyIntList [1,4,9,16]
setglobal "list"
OK <- dostring "list[5] = 25; return list"
- forcePeek $ peekUD typeLazyIntList top
+ forcePeek $ peekUDGeneric typeLazyIntList top
, "List can be shortened" =:
LazyIntList [1, 9, 27, 81] `shouldBeResultOf` do
@@ -239,7 +261,7 @@
pushUD typeLazyIntList $ LazyIntList [1, 9, 27, 81, 243]
setglobal "list"
OK <- dostring "list[5] = nil; return list"
- forcePeek $ peekUD typeLazyIntList top
+ forcePeek $ peekUDGeneric typeLazyIntList top
, "Setting element to nil shortenes the list" =:
LazyIntList [1, 9, 27] `shouldBeResultOf` do
@@ -247,7 +269,7 @@
pushUD typeLazyIntList $ LazyIntList [1, 9, 27, 81, 243]
setglobal "list"
OK <- dostring "list[4] = nil; return list"
- forcePeek $ peekUD typeLazyIntList top
+ forcePeek $ peekUDGeneric typeLazyIntList top
, "Infinite lists are ok" =:
233 `shouldBeResultOf` do
@@ -366,6 +388,10 @@
-> UDTypeWithList e (HaskellFunction e) a itemtype
deftype' = deftypeGeneric' pushHaskellFunction
+-- | Pushes a userdata value of the given type.
+pushUD :: LuaError e => UDTypeWithList e fn a itemtype -> a -> LuaE e ()
+pushUD = pushUDGeneric (const (pure ()))
+
-- | Define a (meta) operation on a type.
operation :: Operation -> HaskellFunction e -> (Operation, HaskellFunction e)
operation = (,)
@@ -386,7 +412,7 @@
]
where
show' = do
- foo <- forcePeek $ peekUD typeFoo (nthBottom 1)
+ foo <- forcePeek $ peekUDGeneric typeFoo (nthBottom 1)
pushString (show foo)
return (NumResults 1)
@@ -396,7 +422,7 @@
typeBar :: LuaError e => UDType e (HaskellFunction e) Bar
typeBar = deftype "Bar" []
- [ property "nums" "some numbers"
+ [ property' "nums" (seqType integerType) "some numbers"
(pushList pushIntegral, \(Bar nums) -> nums)
(peekList peekIntegral, \(Bar _) nums -> Bar nums)
, alias "first" "first element" ["nums", IntegerIndex 1]
@@ -409,7 +435,7 @@
=> UDTypeWithList e (HaskellFunction e) LazyIntList Int
typeLazyIntList = deftype' "LazyIntList"
[ operation Tostring $ do
- lazyList <- forcePeek $ peekUD typeLazyIntList (nthBottom 1)
+ lazyList <- forcePeek $ peekUDGeneric typeLazyIntList (nthBottom 1)
pushString (show lazyList)
return (NumResults 1)
]
@@ -441,6 +467,12 @@
y <- peekFieldRaw peekRealFloat "y" idx
return $ x `seq` y `seq` Point x y
+pointType :: TypeSpec
+pointType = recType
+ [ ("x", numberType)
+ , ("y", numberType)
+ ]
+
showQux :: LuaError e => HaskellFunction e
showQux = do
qux <- forcePeek $ peekQux (nthBottom 1)
@@ -448,13 +480,13 @@
return (NumResults 1)
peekQux :: LuaError e => Peeker e Qux
-peekQux = peekUD typeQux
+peekQux = peekUDGeneric typeQux
typeQux :: LuaError e => UDType e (HaskellFunction e) Qux
typeQux = deftype "Qux"
[ operation Tostring showQux ]
[ methodGeneric "show" showQux
- , property "num" "some number"
+ , property' "num" integerType "some number"
(pushIntegral, \case
Quux n _ -> n
Quuz _ n -> n)
@@ -462,7 +494,7 @@
Quux _ s -> (`Quux` s)
Quuz d _ -> Quuz d)
- , possibleProperty "str" "a string in Quux"
+ , possibleProperty' "str" stringType "a string in Quux"
(pushString, \case
Quux _ s -> Actual s
Quuz {} -> Absent)
@@ -470,7 +502,7 @@
Quux n _ -> Actual . Quux n
Quuz {} -> const Absent)
- , possibleProperty "point" "a point in Quuz"
+ , possibleProperty' "point" pointType "a point in Quuz"
(pushPoint, \case
Quuz p _ -> Actual p
Quux {} -> Absent)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/hslua-objectorientation-2.2.1/test/test-hslua-objectorientation.hs
new/hslua-objectorientation-2.3.0/test/test-hslua-objectorientation.hs
--- old/hslua-objectorientation-2.2.1/test/test-hslua-objectorientation.hs
2001-09-09 03:46:40.000000000 +0200
+++ new/hslua-objectorientation-2.3.0/test/test-hslua-objectorientation.hs
2001-09-09 03:46:40.000000000 +0200
@@ -2,9 +2,9 @@
Module : Main
Copyright : © 2007â2012 Gracjan Polak;
© 2012â2016 Ãmer Sinan AÄacan;
- © 2017-2022 Albert Krewinkel
+ © 2017-2023 Albert Krewinkel
License : MIT
-Maintainer : Albert Krewinkel <[email protected]>
+Maintainer : Albert Krewinkel <[email protected]>
Stability : beta
Portability : non-portable (depends on GHC)
