{-# LANGUAGE CPP #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module HsLua.ObjectOrientation
( UDType
, UDTypeWithList (..)
, deftypeGeneric
, deftypeGeneric'
, methodGeneric
, property
, possibleProperty
, readonly
, alias
, peekUD
, pushUD
, Member
, Property
, Operation (..)
, ListSpec
, Possible (..)
, Alias
, 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
data UDTypeWithList e fn a itemtype = UDTypeWithList
{ UDTypeWithList e fn a itemtype -> Name
udName :: Name
, UDTypeWithList e fn a itemtype -> [(Operation, fn)]
udOperations :: [(Operation, fn)]
, UDTypeWithList e fn a itemtype -> Map Name (Property e a)
udProperties :: Map Name (Property e a)
, UDTypeWithList e fn a itemtype -> Map Name fn
udMethods :: Map Name fn
, UDTypeWithList e fn a itemtype -> Map AliasIndex Alias
udAliases :: Map AliasIndex Alias
, UDTypeWithList e fn a itemtype -> Maybe (ListSpec e a itemtype)
udListSpec :: Maybe (ListSpec e a itemtype)
, UDTypeWithList e fn a itemtype -> fn -> LuaE e ()
udFnPusher :: fn -> LuaE e ()
}
type ListSpec e a itemtype =
( (Pusher e itemtype, a -> [itemtype])
, (Peeker e itemtype, a -> [itemtype] -> a)
)
type UDType e fn a = UDTypeWithList e fn a Void
deftypeGeneric :: Pusher e fn
-> Name
-> [(Operation, fn)]
-> [Member e fn a]
-> UDType e fn a
deftypeGeneric :: Pusher e fn
-> Name -> [(Operation, fn)] -> [Member e fn a] -> UDType e fn a
deftypeGeneric pushFunction :: Pusher e fn
pushFunction name :: Name
name ops :: [(Operation, fn)]
ops members :: [Member e fn a]
members =
Pusher e fn
-> Name
-> [(Operation, fn)]
-> [Member e fn a]
-> Maybe (ListSpec e a Void)
-> UDType e fn a
forall e fn a itemtype.
Pusher e fn
-> Name
-> [(Operation, fn)]
-> [Member e fn a]
-> Maybe (ListSpec e a itemtype)
-> UDTypeWithList e fn a itemtype
deftypeGeneric' Pusher e fn
pushFunction Name
name [(Operation, fn)]
ops [Member e fn a]
members Maybe (ListSpec e a Void)
forall a. Maybe a
Nothing
deftypeGeneric' :: Pusher e fn
-> Name
-> [(Operation, fn)]
-> [Member e fn a]
-> Maybe (ListSpec e a itemtype)
-> UDTypeWithList e fn a itemtype
deftypeGeneric' :: Pusher e fn
-> Name
-> [(Operation, fn)]
-> [Member e fn a]
-> Maybe (ListSpec e a itemtype)
-> UDTypeWithList e fn a itemtype
deftypeGeneric' pushFunction :: Pusher e fn
pushFunction name :: Name
name ops :: [(Operation, fn)]
ops members :: [Member e fn a]
members mbListSpec :: Maybe (ListSpec e a itemtype)
mbListSpec = $WUDTypeWithList :: forall e fn a itemtype.
Name
-> [(Operation, fn)]
-> Map Name (Property e a)
-> Map Name fn
-> Map AliasIndex Alias
-> Maybe (ListSpec e a itemtype)
-> (fn -> LuaE e ())
-> UDTypeWithList e fn a itemtype
UDTypeWithList
{ udName :: Name
udName = Name
name
, udOperations :: [(Operation, fn)]
udOperations = [(Operation, fn)]
ops
, udProperties :: Map Name (Property e a)
udProperties = [(Name, Property e a)] -> Map Name (Property e a)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Name, Property e a)] -> Map Name (Property e a))
-> [(Name, Property e a)] -> Map Name (Property e a)
forall a b. (a -> b) -> a -> b
$ (Member e fn a -> Maybe (Name, Property e a))
-> [Member e fn a] -> [(Name, Property e a)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Member e fn a -> Maybe (Name, Property e a)
forall e fn a. Member e fn a -> Maybe (Name, Property e a)
mbproperties [Member e fn a]
members
, udMethods :: Map Name fn
udMethods = [(Name, fn)] -> Map Name fn
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Name, fn)] -> Map Name fn) -> [(Name, fn)] -> Map Name fn
forall a b. (a -> b) -> a -> b
$ (Member e fn a -> Maybe (Name, fn))
-> [Member e fn a] -> [(Name, fn)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Member e fn a -> Maybe (Name, fn)
forall e b a. Member e b a -> Maybe (Name, b)
mbmethods [Member e fn a]
members
, udAliases :: Map AliasIndex Alias
udAliases = [(AliasIndex, Alias)] -> Map AliasIndex Alias
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(AliasIndex, Alias)] -> Map AliasIndex Alias)
-> [(AliasIndex, Alias)] -> Map AliasIndex Alias
forall a b. (a -> b) -> a -> b
$ (Member e fn a -> Maybe (AliasIndex, Alias))
-> [Member e fn a] -> [(AliasIndex, Alias)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Member e fn a -> Maybe (AliasIndex, Alias)
forall e fn a. Member e fn a -> Maybe (AliasIndex, Alias)
mbaliases [Member e fn a]
members
, udListSpec :: Maybe (ListSpec e a itemtype)
udListSpec = Maybe (ListSpec e a itemtype)
mbListSpec
, udFnPusher :: Pusher e fn
udFnPusher = Pusher e fn
pushFunction
}
where
mbproperties :: Member e fn a -> Maybe (Name, Property e a)
mbproperties = \case
MemberProperty n :: Name
n p :: Property e a
p -> (Name, Property e a) -> Maybe (Name, Property e a)
forall a. a -> Maybe a
Just (Name
n, Property e a
p)
_ -> Maybe (Name, Property e a)
forall a. Maybe a
Nothing
mbmethods :: Member e b a -> Maybe (Name, b)
mbmethods = \case
MemberMethod n :: Name
n m :: b
m -> (Name, b) -> Maybe (Name, b)
forall a. a -> Maybe a
Just (Name
n, b
m)
_ -> Maybe (Name, b)
forall a. Maybe a
Nothing
mbaliases :: Member e fn a -> Maybe (AliasIndex, Alias)
mbaliases = \case
MemberAlias n :: AliasIndex
n a :: Alias
a -> (AliasIndex, Alias) -> Maybe (AliasIndex, Alias)
forall a. a -> Maybe a
Just (AliasIndex
n, Alias
a)
_ -> Maybe (AliasIndex, Alias)
forall a. Maybe a
Nothing
data Property e a = Property
{ Property e a -> a -> LuaE e NumResults
propertyGet :: a -> LuaE e NumResults
, Property e a -> Maybe (StackIndex -> a -> LuaE e a)
propertySet :: Maybe (StackIndex -> a -> LuaE e a)
, Property e a -> Text
propertyDescription :: Text
}
type Alias = [AliasIndex]
data AliasIndex
= StringIndex Name
| IntegerIndex Lua.Integer
deriving (AliasIndex -> AliasIndex -> Bool
(AliasIndex -> AliasIndex -> Bool)
-> (AliasIndex -> AliasIndex -> Bool) -> Eq AliasIndex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AliasIndex -> AliasIndex -> Bool
$c/= :: AliasIndex -> AliasIndex -> Bool
== :: AliasIndex -> AliasIndex -> Bool
$c== :: AliasIndex -> AliasIndex -> Bool
Eq, Eq AliasIndex
Eq AliasIndex =>
(AliasIndex -> AliasIndex -> Ordering)
-> (AliasIndex -> AliasIndex -> Bool)
-> (AliasIndex -> AliasIndex -> Bool)
-> (AliasIndex -> AliasIndex -> Bool)
-> (AliasIndex -> AliasIndex -> Bool)
-> (AliasIndex -> AliasIndex -> AliasIndex)
-> (AliasIndex -> AliasIndex -> AliasIndex)
-> Ord AliasIndex
AliasIndex -> AliasIndex -> Bool
AliasIndex -> AliasIndex -> Ordering
AliasIndex -> AliasIndex -> AliasIndex
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AliasIndex -> AliasIndex -> AliasIndex
$cmin :: AliasIndex -> AliasIndex -> AliasIndex
max :: AliasIndex -> AliasIndex -> AliasIndex
$cmax :: AliasIndex -> AliasIndex -> AliasIndex
>= :: AliasIndex -> AliasIndex -> Bool
$c>= :: AliasIndex -> AliasIndex -> Bool
> :: AliasIndex -> AliasIndex -> Bool
$c> :: AliasIndex -> AliasIndex -> Bool
<= :: AliasIndex -> AliasIndex -> Bool
$c<= :: AliasIndex -> AliasIndex -> Bool
< :: AliasIndex -> AliasIndex -> Bool
$c< :: AliasIndex -> AliasIndex -> Bool
compare :: AliasIndex -> AliasIndex -> Ordering
$ccompare :: AliasIndex -> AliasIndex -> Ordering
$cp1Ord :: Eq AliasIndex
Ord)
instance IsString AliasIndex where
fromString :: String -> AliasIndex
fromString = Name -> AliasIndex
StringIndex (Name -> AliasIndex) -> (String -> Name) -> String -> AliasIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Name
forall a. IsString a => String -> a
fromString
data Member e fn a
= MemberProperty Name (Property e a)
| MemberMethod Name fn
| MemberAlias AliasIndex Alias
methodGeneric :: Name -> fn -> Member e fn a
methodGeneric :: Name -> fn -> Member e fn a
methodGeneric = Name -> fn -> Member e fn a
forall e fn a. Name -> fn -> Member e fn a
MemberMethod
data Possible a
= Actual a
| Absent
property :: LuaError e
=> Name
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property :: Name
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property name :: Name
name desc :: Text
desc (push :: Pusher e b
push, get :: a -> b
get) (peek :: Peeker e b
peek, set :: a -> b -> a
set) =
Name
-> Text
-> (Pusher e b, a -> Possible b)
-> (Peeker e b, a -> b -> Possible a)
-> Member e fn a
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> Possible b)
-> (Peeker e b, a -> b -> Possible a)
-> Member e fn a
possibleProperty Name
name Text
desc
(Pusher e b
push, b -> Possible b
forall a. a -> Possible a
Actual (b -> Possible b) -> (a -> b) -> a -> Possible b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
get)
(Peeker e b
peek, \a :: a
a b :: b
b -> a -> Possible a
forall a. a -> Possible a
Actual (a -> b -> a
set a
a b
b))
possibleProperty :: LuaError e
=> Name
-> Text
-> (Pusher e b, a -> Possible b)
-> (Peeker e b, a -> b -> Possible a)
-> Member e fn a
possibleProperty :: Name
-> Text
-> (Pusher e b, a -> Possible b)
-> (Peeker e b, a -> b -> Possible a)
-> Member e fn a
possibleProperty name :: Name
name desc :: Text
desc (push :: Pusher e b
push, get :: a -> Possible b
get) (peek :: Peeker e b
peek, set :: a -> b -> Possible a
set) = Name -> Property e a -> Member e fn a
forall e fn a. Name -> Property e a -> Member e fn a
MemberProperty Name
name (Property e a -> Member e fn a) -> Property e a -> Member e fn a
forall a b. (a -> b) -> a -> b
$
$WProperty :: forall e a.
(a -> LuaE e NumResults)
-> Maybe (StackIndex -> a -> LuaE e a) -> Text -> Property e a
Property
{ propertyGet :: a -> LuaE e NumResults
propertyGet = \x :: a
x -> do
case a -> Possible b
get a
x of
Actual y :: b
y -> CInt -> NumResults
NumResults 1 NumResults -> LuaE e () -> LuaE e NumResults
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Pusher e b
push b
y
Absent -> NumResults -> LuaE e NumResults
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> NumResults
NumResults 0)
, propertySet :: Maybe (StackIndex -> a -> LuaE e a)
propertySet = (StackIndex -> a -> LuaE e a)
-> Maybe (StackIndex -> a -> LuaE e a)
forall a. a -> Maybe a
Just ((StackIndex -> a -> LuaE e a)
-> Maybe (StackIndex -> a -> LuaE e a))
-> (StackIndex -> a -> LuaE e a)
-> Maybe (StackIndex -> a -> LuaE e a)
forall a b. (a -> b) -> a -> b
$ \idx :: StackIndex
idx x :: a
x -> do
b
value <- Peek e b -> LuaE e b
forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek (Peek e b -> LuaE e b) -> Peek e b -> LuaE e b
forall a b. (a -> b) -> a -> b
$ Peeker e b
peek StackIndex
idx
case a -> b -> Possible a
set a
x b
value of
Actual y :: a
y -> a -> LuaE e a
forall (m :: * -> *) a. Monad m => a -> m a
return a
y
Absent -> String -> LuaE e a
forall e a. LuaError e => String -> LuaE e a
failLua (String -> LuaE e a) -> String -> LuaE e a
forall a b. (a -> b) -> a -> b
$ "Trying to set unavailable property "
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
Utf8.toString (Name -> ByteString
fromName Name
name)
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> "."
, propertyDescription :: Text
propertyDescription = Text
desc
}
readonly :: Name
-> Text
-> (Pusher e b, a -> b)
-> Member e fn a
readonly :: Name -> Text -> (Pusher e b, a -> b) -> Member e fn a
readonly name :: Name
name desc :: Text
desc (push :: Pusher e b
push, get :: a -> b
get) = Name -> Property e a -> Member e fn a
forall e fn a. Name -> Property e a -> Member e fn a
MemberProperty Name
name (Property e a -> Member e fn a) -> Property e a -> Member e fn a
forall a b. (a -> b) -> a -> b
$
$WProperty :: forall e a.
(a -> LuaE e NumResults)
-> Maybe (StackIndex -> a -> LuaE e a) -> Text -> Property e a
Property
{ propertyGet :: a -> LuaE e NumResults
propertyGet = \x :: a
x -> do
Pusher e b
push Pusher e b -> Pusher e b
forall a b. (a -> b) -> a -> b
$ a -> b
get a
x
NumResults -> LuaE e NumResults
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> NumResults
NumResults 1)
, propertySet :: Maybe (StackIndex -> a -> LuaE e a)
propertySet = Maybe (StackIndex -> a -> LuaE e a)
forall a. Maybe a
Nothing
, propertyDescription :: Text
propertyDescription = Text
desc
}
alias :: AliasIndex
-> Text
-> [AliasIndex]
-> Member e fn a
alias :: AliasIndex -> Text -> Alias -> Member e fn a
alias name :: AliasIndex
name _desc :: Text
_desc = AliasIndex -> Alias -> Member e fn a
forall e fn a. AliasIndex -> Alias -> Member e fn a
MemberAlias AliasIndex
name
pushUDMetatable :: LuaError e => UDTypeWithList e fn a itemtype -> LuaE e ()
pushUDMetatable :: UDTypeWithList e fn a itemtype -> LuaE e ()
pushUDMetatable ty :: UDTypeWithList e fn a itemtype
ty = do
Bool
created <- Name -> LuaE e Bool
forall e. Name -> LuaE e Bool
newudmetatable (UDTypeWithList e fn a itemtype -> Name
forall e fn a itemtype. UDTypeWithList e fn a itemtype -> Name
udName UDTypeWithList e fn a itemtype
ty)
Bool -> LuaE e () -> LuaE e ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
created (LuaE e () -> LuaE e ()) -> LuaE e () -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ do
Name -> LuaE e () -> LuaE e ()
forall e. LuaError e => Name -> LuaE e () -> LuaE e ()
add (Operation -> Name
metamethodName Operation
Index) (LuaE e () -> LuaE e ()) -> LuaE e () -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ CFunction -> LuaE e ()
forall e. CFunction -> LuaE e ()
pushcfunction CFunction
hslua_udindex_ptr
Name -> LuaE e () -> LuaE e ()
forall e. LuaError e => Name -> LuaE e () -> LuaE e ()
add (Operation -> Name
metamethodName Operation
Newindex) (LuaE e () -> LuaE e ()) -> LuaE e () -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ CFunction -> LuaE e ()
forall e. CFunction -> LuaE e ()
pushcfunction CFunction
hslua_udnewindex_ptr
Name -> LuaE e () -> LuaE e ()
forall e. LuaError e => Name -> LuaE e () -> LuaE e ()
add (Operation -> Name
metamethodName Operation
Pairs) (LuaE e () -> LuaE e ()) -> LuaE e () -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ HaskellFunction e -> LuaE e ()
forall e. LuaError e => HaskellFunction e -> LuaE e ()
pushHaskellFunction (UDTypeWithList e fn a itemtype -> HaskellFunction e
forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> LuaE e NumResults
pairsFunction UDTypeWithList e fn a itemtype
ty)
[(Operation, fn)] -> ((Operation, fn) -> LuaE e ()) -> LuaE e ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (UDTypeWithList e fn a itemtype -> [(Operation, fn)]
forall e fn a itemtype.
UDTypeWithList e fn a itemtype -> [(Operation, fn)]
udOperations UDTypeWithList e fn a itemtype
ty) (((Operation, fn) -> LuaE e ()) -> LuaE e ())
-> ((Operation, fn) -> LuaE e ()) -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ \(op :: Operation
op, f :: fn
f) -> do
Name -> LuaE e () -> LuaE e ()
forall e. LuaError e => Name -> LuaE e () -> LuaE e ()
add (Operation -> Name
metamethodName Operation
op) (LuaE e () -> LuaE e ()) -> LuaE e () -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ UDTypeWithList e fn a itemtype -> fn -> LuaE e ()
forall e fn a itemtype.
UDTypeWithList e fn a itemtype -> fn -> LuaE e ()
udFnPusher UDTypeWithList e fn a itemtype
ty fn
f
Name -> LuaE e () -> LuaE e ()
forall e. LuaError e => Name -> LuaE e () -> LuaE e ()
add "getters" (LuaE e () -> LuaE e ()) -> LuaE e () -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ UDTypeWithList e fn a itemtype -> LuaE e ()
forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> LuaE e ()
pushGetters UDTypeWithList e fn a itemtype
ty
Name -> LuaE e () -> LuaE e ()
forall e. LuaError e => Name -> LuaE e () -> LuaE e ()
add "setters" (LuaE e () -> LuaE e ()) -> LuaE e () -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ UDTypeWithList e fn a itemtype -> LuaE e ()
forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> LuaE e ()
pushSetters UDTypeWithList e fn a itemtype
ty
Name -> LuaE e () -> LuaE e ()
forall e. LuaError e => Name -> LuaE e () -> LuaE e ()
add "methods" (LuaE e () -> LuaE e ()) -> LuaE e () -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ UDTypeWithList e fn a itemtype -> LuaE e ()
forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> LuaE e ()
pushMethods UDTypeWithList e fn a itemtype
ty
Name -> LuaE e () -> LuaE e ()
forall e. LuaError e => Name -> LuaE e () -> LuaE e ()
add "aliases" (LuaE e () -> LuaE e ()) -> LuaE e () -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ UDTypeWithList e fn a itemtype -> LuaE e ()
forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> LuaE e ()
pushAliases UDTypeWithList e fn a itemtype
ty
case UDTypeWithList e fn a itemtype -> Maybe (ListSpec e a itemtype)
forall e fn a itemtype.
UDTypeWithList e fn a itemtype -> Maybe (ListSpec e a itemtype)
udListSpec UDTypeWithList e fn a itemtype
ty of
Nothing -> () -> LuaE e ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just ((pushItem :: Pusher e itemtype
pushItem, _), _) -> do
Name -> LuaE e () -> LuaE e ()
forall e. LuaError e => Name -> LuaE e () -> LuaE e ()
add "lazylisteval" (LuaE e () -> LuaE e ()) -> LuaE e () -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ HaskellFunction e -> LuaE e ()
forall e. LuaError e => HaskellFunction e -> LuaE e ()
pushHaskellFunction (Pusher e itemtype -> HaskellFunction e
forall itemtype e.
LuaError e =>
Pusher e itemtype -> LuaE e NumResults
lazylisteval Pusher e itemtype
pushItem)
where
add :: LuaError e => Name -> LuaE e () -> LuaE e ()
add :: Name -> LuaE e () -> LuaE e ()
add name :: Name
name op :: LuaE e ()
op = do
Name -> LuaE e ()
forall e. Name -> LuaE e ()
pushName Name
name
LuaE e ()
op
StackIndex -> LuaE e ()
forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth 3)
foreign import ccall "hslobj.c &hslua_udindex"
hslua_udindex_ptr :: FunPtr (State -> IO NumResults)
foreign import ccall "hslobj.c &hslua_udnewindex"
hslua_udnewindex_ptr :: FunPtr (State -> IO NumResults)
foreign import ccall "hslobj.c &hslua_udsetter"
hslua_udsetter_ptr :: FunPtr (State -> IO NumResults)
foreign import ccall "hslobj.c &hslua_udreadonly"
hslua_udreadonly_ptr :: FunPtr (State -> IO NumResults)
pushGetters :: LuaError e => UDTypeWithList e fn a itemtype -> LuaE e ()
pushGetters :: UDTypeWithList e fn a itemtype -> LuaE e ()
pushGetters ty :: UDTypeWithList e fn a itemtype
ty = do
LuaE e ()
forall e. LuaE e ()
newtable
LuaE e (Map Name ()) -> LuaE e ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (LuaE e (Map Name ()) -> LuaE e ())
-> LuaE e (Map Name ()) -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ ((Name -> Property e a -> LuaE e ())
-> Map Name (Property e a) -> LuaE e (Map Name ()))
-> Map Name (Property e a)
-> (Name -> Property e a -> LuaE e ())
-> LuaE e (Map Name ())
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Name -> Property e a -> LuaE e ())
-> Map Name (Property e a) -> LuaE e (Map Name ())
forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
Map.traverseWithKey (UDTypeWithList e fn a itemtype -> Map Name (Property e a)
forall e fn a itemtype.
UDTypeWithList e fn a itemtype -> Map Name (Property e a)
udProperties UDTypeWithList e fn a itemtype
ty) ((Name -> Property e a -> LuaE e ()) -> LuaE e (Map Name ()))
-> (Name -> Property e a -> LuaE e ()) -> LuaE e (Map Name ())
forall a b. (a -> b) -> a -> b
$ \name :: Name
name prop :: Property e a
prop -> do
Name -> LuaE e ()
forall e. Name -> LuaE e ()
pushName Name
name
HaskellFunction e -> LuaE e ()
forall e. LuaError e => HaskellFunction e -> LuaE e ()
pushHaskellFunction (HaskellFunction e -> LuaE e ()) -> HaskellFunction e -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ Peek e a -> LuaE e a
forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek (UDTypeWithList e fn a itemtype -> Peeker e a
forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> Peeker e a
peekUD UDTypeWithList e fn a itemtype
ty 1) LuaE e a -> (a -> HaskellFunction e) -> HaskellFunction e
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Property e a -> a -> HaskellFunction e
forall e a. Property e a -> a -> LuaE e NumResults
propertyGet Property e a
prop
StackIndex -> LuaE e ()
forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth 3)
pushSetters :: LuaError e => UDTypeWithList e fn a itemtype -> LuaE e ()
pushSetters :: UDTypeWithList e fn a itemtype -> LuaE e ()
pushSetters ty :: UDTypeWithList e fn a itemtype
ty = do
LuaE e ()
forall e. LuaE e ()
newtable
LuaE e (Map Name ()) -> LuaE e ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (LuaE e (Map Name ()) -> LuaE e ())
-> LuaE e (Map Name ()) -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ ((Name -> Property e a -> LuaE e ())
-> Map Name (Property e a) -> LuaE e (Map Name ()))
-> Map Name (Property e a)
-> (Name -> Property e a -> LuaE e ())
-> LuaE e (Map Name ())
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Name -> Property e a -> LuaE e ())
-> Map Name (Property e a) -> LuaE e (Map Name ())
forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
Map.traverseWithKey (UDTypeWithList e fn a itemtype -> Map Name (Property e a)
forall e fn a itemtype.
UDTypeWithList e fn a itemtype -> Map Name (Property e a)
udProperties UDTypeWithList e fn a itemtype
ty) ((Name -> Property e a -> LuaE e ()) -> LuaE e (Map Name ()))
-> (Name -> Property e a -> LuaE e ()) -> LuaE e (Map Name ())
forall a b. (a -> b) -> a -> b
$ \name :: Name
name prop :: Property e a
prop -> do
Name -> LuaE e ()
forall e. Name -> LuaE e ()
pushName Name
name
CFunction -> LuaE e ()
forall e. CFunction -> LuaE e ()
pushcfunction (CFunction -> LuaE e ()) -> CFunction -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ case Property e a -> Maybe (StackIndex -> a -> LuaE e a)
forall e a. Property e a -> Maybe (StackIndex -> a -> LuaE e a)
propertySet Property e a
prop of
Just _ -> CFunction
hslua_udsetter_ptr
Nothing -> CFunction
hslua_udreadonly_ptr
StackIndex -> LuaE e ()
forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth 3)
pushMethods :: LuaError e => UDTypeWithList e fn a itemtype -> LuaE e ()
pushMethods :: UDTypeWithList e fn a itemtype -> LuaE e ()
pushMethods ty :: UDTypeWithList e fn a itemtype
ty = do
LuaE e ()
forall e. LuaE e ()
newtable
LuaE e (Map Name ()) -> LuaE e ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (LuaE e (Map Name ()) -> LuaE e ())
-> LuaE e (Map Name ()) -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ ((Name -> fn -> LuaE e ()) -> Map Name fn -> LuaE e (Map Name ()))
-> Map Name fn -> (Name -> fn -> LuaE e ()) -> LuaE e (Map Name ())
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Name -> fn -> LuaE e ()) -> Map Name fn -> LuaE e (Map Name ())
forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
Map.traverseWithKey (UDTypeWithList e fn a itemtype -> Map Name fn
forall e fn a itemtype.
UDTypeWithList e fn a itemtype -> Map Name fn
udMethods UDTypeWithList e fn a itemtype
ty) ((Name -> fn -> LuaE e ()) -> LuaE e (Map Name ()))
-> (Name -> fn -> LuaE e ()) -> LuaE e (Map Name ())
forall a b. (a -> b) -> a -> b
$ \name :: Name
name fn :: fn
fn -> do
Name -> LuaE e ()
forall e. Name -> LuaE e ()
pushName Name
name
UDTypeWithList e fn a itemtype -> fn -> LuaE e ()
forall e fn a itemtype.
UDTypeWithList e fn a itemtype -> fn -> LuaE e ()
udFnPusher UDTypeWithList e fn a itemtype
ty fn
fn
StackIndex -> LuaE e ()
forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth 3)
pushAliases :: LuaError e => UDTypeWithList e fn a itemtype -> LuaE e ()
pushAliases :: UDTypeWithList e fn a itemtype -> LuaE e ()
pushAliases ty :: UDTypeWithList e fn a itemtype
ty = do
LuaE e ()
forall e. LuaE e ()
newtable
LuaE e (Map AliasIndex ()) -> LuaE e ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (LuaE e (Map AliasIndex ()) -> LuaE e ())
-> LuaE e (Map AliasIndex ()) -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ ((AliasIndex -> Alias -> LuaE e ())
-> Map AliasIndex Alias -> LuaE e (Map AliasIndex ()))
-> Map AliasIndex Alias
-> (AliasIndex -> Alias -> LuaE e ())
-> LuaE e (Map AliasIndex ())
forall a b c. (a -> b -> c) -> b -> a -> c
flip (AliasIndex -> Alias -> LuaE e ())
-> Map AliasIndex Alias -> LuaE e (Map AliasIndex ())
forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
Map.traverseWithKey (UDTypeWithList e fn a itemtype -> Map AliasIndex Alias
forall e fn a itemtype.
UDTypeWithList e fn a itemtype -> Map AliasIndex Alias
udAliases UDTypeWithList e fn a itemtype
ty) ((AliasIndex -> Alias -> LuaE e ()) -> LuaE e (Map AliasIndex ()))
-> (AliasIndex -> Alias -> LuaE e ()) -> LuaE e (Map AliasIndex ())
forall a b. (a -> b) -> a -> b
$ \name :: AliasIndex
name propSeq :: Alias
propSeq -> do
Pusher e AliasIndex
forall e. Pusher e AliasIndex
pushAliasIndex AliasIndex
name
Pusher e AliasIndex -> Alias -> LuaE e ()
forall e a. LuaError e => Pusher e a -> [a] -> LuaE e ()
pushList Pusher e AliasIndex
forall e. Pusher e AliasIndex
pushAliasIndex Alias
propSeq
StackIndex -> LuaE e ()
forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth 3)
pushAliasIndex :: Pusher e AliasIndex
pushAliasIndex :: Pusher e AliasIndex
pushAliasIndex = \case
StringIndex name :: Name
name -> Name -> LuaE e ()
forall e. Name -> LuaE e ()
pushName Name
name
IntegerIndex n :: Integer
n -> Integer -> LuaE e ()
forall a e. (Integral a, Show a) => a -> LuaE e ()
pushIntegral Integer
n
pairsFunction :: forall e fn a itemtype. LuaError e
=> UDTypeWithList e fn a itemtype -> LuaE e NumResults
pairsFunction :: UDTypeWithList e fn a itemtype -> LuaE e NumResults
pairsFunction ty :: UDTypeWithList e fn a itemtype
ty = do
a
obj <- Peek e a -> LuaE e a
forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek (Peek e a -> LuaE e a) -> Peek e a -> LuaE e a
forall a b. (a -> b) -> a -> b
$ UDTypeWithList e fn a itemtype -> Peeker e a
forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> Peeker e a
peekUD UDTypeWithList e fn a itemtype
ty (CInt -> StackIndex
nthBottom 1)
let pushMember :: Member e fn a -> LuaE e NumResults
pushMember = \case
MemberProperty name :: Name
name prop :: Property e a
prop -> do
Name -> LuaE e ()
forall e. Name -> LuaE e ()
pushName Name
name
NumResults
getresults <- Property e a -> a -> LuaE e NumResults
forall e a. Property e a -> a -> LuaE e NumResults
propertyGet Property e a
prop a
obj
if NumResults
getresults NumResults -> NumResults -> Bool
forall a. Eq a => a -> a -> Bool
== 0
then 0 NumResults -> LuaE e () -> LuaE e NumResults
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop 1
else NumResults -> LuaE e NumResults
forall (m :: * -> *) a. Monad m => a -> m a
return (NumResults -> LuaE e NumResults)
-> NumResults -> LuaE e NumResults
forall a b. (a -> b) -> a -> b
$ NumResults
getresults NumResults -> NumResults -> NumResults
forall a. Num a => a -> a -> a
+ 1
MemberMethod name :: Name
name f :: fn
f -> do
Name -> LuaE e ()
forall e. Name -> LuaE e ()
pushName Name
name
UDTypeWithList e fn a itemtype -> fn -> LuaE e ()
forall e fn a itemtype.
UDTypeWithList e fn a itemtype -> fn -> LuaE e ()
udFnPusher UDTypeWithList e fn a itemtype
ty fn
f
NumResults -> LuaE e NumResults
forall (m :: * -> *) a. Monad m => a -> m a
return 2
MemberAlias{} -> String -> LuaE e NumResults
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "aliases are not full properties"
(Member e fn a -> LuaE e NumResults)
-> [Member e fn a] -> LuaE e NumResults
forall a e.
LuaError e =>
(a -> LuaE e NumResults) -> [a] -> LuaE e NumResults
pushIterator Member e fn a -> LuaE e NumResults
pushMember ([Member e fn a] -> LuaE e NumResults)
-> [Member e fn a] -> LuaE e NumResults
forall a b. (a -> b) -> a -> b
$
((Name, Property e a) -> Member e fn a)
-> [(Name, Property e a)] -> [Member e fn a]
forall a b. (a -> b) -> [a] -> [b]
map ((Name -> Property e a -> Member e fn a)
-> (Name, Property e a) -> Member e fn a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Name -> Property e a -> Member e fn a
forall e fn a. Name -> Property e a -> Member e fn a
MemberProperty) (Map Name (Property e a) -> [(Name, Property e a)]
forall k a. Map k a -> [(k, a)]
Map.toAscList (UDTypeWithList e fn a itemtype -> Map Name (Property e a)
forall e fn a itemtype.
UDTypeWithList e fn a itemtype -> Map Name (Property e a)
udProperties UDTypeWithList e fn a itemtype
ty)) [Member e fn a] -> [Member e fn a] -> [Member e fn a]
forall a. [a] -> [a] -> [a]
++
((Name, fn) -> Member e fn a) -> [(Name, fn)] -> [Member e fn a]
forall a b. (a -> b) -> [a] -> [b]
map ((Name -> fn -> Member e fn a) -> (Name, fn) -> Member e fn a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Name -> fn -> Member e fn a
forall e fn a. Name -> fn -> Member e fn a
MemberMethod) (Map Name fn -> [(Name, fn)]
forall k a. Map k a -> [(k, a)]
Map.toAscList (UDTypeWithList e fn a itemtype -> Map Name fn
forall e fn a itemtype.
UDTypeWithList e fn a itemtype -> Map Name fn
udMethods UDTypeWithList e fn a itemtype
ty))
lazylisteval :: forall itemtype e. LuaError e
=> Pusher e itemtype -> LuaE e NumResults
lazylisteval :: Pusher e itemtype -> LuaE e NumResults
lazylisteval pushItem :: Pusher e itemtype
pushItem = do
Maybe [itemtype]
munevaled <- StackIndex -> Name -> LuaE e (Maybe [itemtype])
forall a e. StackIndex -> Name -> LuaE e (Maybe a)
fromuserdata @[itemtype] (CInt -> StackIndex
nthBottom 1) Name
lazyListStateName
Maybe Integer
mcurindex <- StackIndex -> LuaE e (Maybe Integer)
forall e. StackIndex -> LuaE e (Maybe Integer)
tointeger (CInt -> StackIndex
nthBottom 2)
Maybe Integer
mnewindex <- StackIndex -> LuaE e (Maybe Integer)
forall e. StackIndex -> LuaE e (Maybe Integer)
tointeger (CInt -> StackIndex
nthBottom 3)
case (Maybe [itemtype]
munevaled, Maybe Integer
mcurindex, Maybe Integer
mnewindex) of
(Just unevaled :: [itemtype]
unevaled, Just curindex :: Integer
curindex, Just newindex :: Integer
newindex) -> do
let numElems :: Int
numElems = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
max (Integer
newindex Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
curindex) 0
(as :: [itemtype]
as, rest :: [itemtype]
rest) = Int -> [itemtype] -> ([itemtype], [itemtype])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
numElems [itemtype]
unevaled
if [itemtype] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [itemtype]
rest
then do
Name -> LuaE e ()
forall e. Name -> LuaE e ()
pushName "__lazylistindex"
Pusher e Bool
forall e. Pusher e Bool
pushBool Bool
False
StackIndex -> LuaE e ()
forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nthBottom 4)
else do
LuaE e Bool -> LuaE e ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (LuaE e Bool -> LuaE e ()) -> LuaE e Bool -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ StackIndex -> Name -> [itemtype] -> LuaE e Bool
forall a e. StackIndex -> Name -> a -> LuaE e Bool
putuserdata @[itemtype] (CInt -> StackIndex
nthBottom 1) Name
lazyListStateName [itemtype]
rest
Name -> LuaE e ()
forall e. Name -> LuaE e ()
pushName "__lazylistindex"
Integer -> LuaE e ()
forall e. Integer -> LuaE e ()
pushinteger (Integer
curindex Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([itemtype] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [itemtype]
as))
StackIndex -> LuaE e ()
forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nthBottom 4)
[(Integer, itemtype)]
-> ((Integer, itemtype) -> LuaE e ()) -> LuaE e ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Integer] -> [itemtype] -> [(Integer, itemtype)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Integer
curindex Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ 1)..] [itemtype]
as) (((Integer, itemtype) -> LuaE e ()) -> LuaE e ())
-> ((Integer, itemtype) -> LuaE e ()) -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ \(i :: Integer
i, a :: itemtype
a) -> do
Pusher e itemtype
pushItem itemtype
a
StackIndex -> Integer -> LuaE e ()
forall e. LuaError e => StackIndex -> Integer -> LuaE e ()
rawseti (CInt -> StackIndex
nthBottom 4) Integer
i
NumResults -> LuaE e NumResults
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> NumResults
NumResults 0)
_ -> NumResults -> LuaE e NumResults
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CInt -> NumResults
NumResults 0)
lazyListStateName :: Name
lazyListStateName :: Name
lazyListStateName = "HsLua unevalled lazy list"
pushUD :: LuaError e => UDTypeWithList e fn a itemtype -> a -> LuaE e ()
pushUD :: UDTypeWithList e fn a itemtype -> a -> LuaE e ()
pushUD ty :: UDTypeWithList e fn a itemtype
ty x :: a
x = do
a -> LuaE e ()
forall a e. a -> LuaE e ()
newhsuserdata a
x
UDTypeWithList e fn a itemtype -> LuaE e ()
forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> LuaE e ()
pushUDMetatable UDTypeWithList e fn a itemtype
ty
StackIndex -> LuaE e ()
forall e. StackIndex -> LuaE e ()
setmetatable (CInt -> StackIndex
nth 2)
case UDTypeWithList e fn a itemtype -> Maybe (ListSpec e a itemtype)
forall e fn a itemtype.
UDTypeWithList e fn a itemtype -> Maybe (ListSpec e a itemtype)
udListSpec UDTypeWithList e fn a itemtype
ty of
Nothing -> () -> LuaE e ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just ((_, toList :: a -> [itemtype]
toList), _) -> do
LuaE e ()
forall e. LuaE e ()
newtable
Name -> LuaE e ()
forall e. Name -> LuaE e ()
pushName "__lazylist"
[itemtype] -> LuaE e ()
forall a e. a -> LuaE e ()
newhsuserdata (a -> [itemtype]
toList a
x)
LuaE e Bool -> LuaE e ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Name -> LuaE e Bool
forall e. Name -> LuaE e Bool
newudmetatable Name
lazyListStateName)
StackIndex -> LuaE e ()
forall e. StackIndex -> LuaE e ()
setmetatable (CInt -> StackIndex
nth 2)
StackIndex -> LuaE e ()
forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth 3)
StackIndex -> LuaE e ()
forall e. StackIndex -> LuaE e ()
setuservalue (CInt -> StackIndex
nth 2)
peekUD :: LuaError e => UDTypeWithList e fn a itemtype -> Peeker e a
peekUD :: UDTypeWithList e fn a itemtype -> Peeker e a
peekUD ty :: UDTypeWithList e fn a itemtype
ty idx :: StackIndex
idx = do
let name :: Name
name = UDTypeWithList e fn a itemtype -> Name
forall e fn a itemtype. UDTypeWithList e fn a itemtype -> Name
udName UDTypeWithList e fn a itemtype
ty
a
x <- Name -> (StackIndex -> LuaE e (Maybe a)) -> Peeker e a
forall e a. Name -> (StackIndex -> LuaE e (Maybe a)) -> Peeker e a
reportValueOnFailure Name
name (StackIndex -> Name -> LuaE e (Maybe a)
forall a e. StackIndex -> Name -> LuaE e (Maybe a)
`fromuserdata` Name
name) StackIndex
idx
(Peek e a -> LuaE e () -> Peek e a
forall e a b. Peek e a -> LuaE e b -> Peek e a
`lastly` Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop 1) (Peek e a -> Peek e a) -> Peek e a -> Peek e a
forall a b. (a -> b) -> a -> b
$ LuaE e Type -> Peek e Type
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> LuaE e Type
forall e. StackIndex -> LuaE e Type
getuservalue StackIndex
idx) Peek e Type -> (Type -> Peek e a) -> Peek e a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
TypeTable -> do
a
xWithList <- (a -> Peek e a)
-> (ListSpec e a itemtype -> a -> Peek e a)
-> Maybe (ListSpec e a itemtype)
-> a
-> Peek e a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe a -> Peek e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ListSpec e a itemtype -> a -> Peek e a
forall itemtype e a.
LuaError e =>
ListSpec e a itemtype -> a -> Peek e a
setList (UDTypeWithList e fn a itemtype -> Maybe (ListSpec e a itemtype)
forall e fn a itemtype.
UDTypeWithList e fn a itemtype -> Maybe (ListSpec e a itemtype)
udListSpec UDTypeWithList e fn a itemtype
ty) a
x
LuaE e a -> Peek e a
forall e a. LuaE e a -> Peek e a
liftLua (LuaE e a -> Peek e a) -> LuaE e a -> Peek e a
forall a b. (a -> b) -> a -> b
$ do
LuaE e ()
forall e. LuaE e ()
pushnil
Map Name (Property e a) -> a -> LuaE e a
forall e a. LuaError e => Map Name (Property e a) -> a -> LuaE e a
setProperties (UDTypeWithList e fn a itemtype -> Map Name (Property e a)
forall e fn a itemtype.
UDTypeWithList e fn a itemtype -> Map Name (Property e a)
udProperties UDTypeWithList e fn a itemtype
ty) a
xWithList
_ -> a -> Peek e a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
setProperties :: LuaError e => Map Name (Property e a) -> a -> LuaE e a
setProperties :: Map Name (Property e a) -> a -> LuaE e a
setProperties props :: Map Name (Property e a)
props x :: a
x = do
Bool
hasNext <- StackIndex -> LuaE e Bool
forall e. StackIndex -> LuaE e Bool
Unsafe.next (CInt -> StackIndex
nth 2)
if Bool -> Bool
not Bool
hasNext
then a -> LuaE e a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
else StackIndex -> LuaE e Type
forall e. StackIndex -> LuaE e Type
ltype (CInt -> StackIndex
nth 2) LuaE e Type -> (Type -> LuaE e a) -> LuaE e a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
TypeString -> do
Name
propName <- Peek e Name -> LuaE e Name
forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek (Peek e Name -> LuaE e Name) -> Peek e Name -> LuaE e Name
forall a b. (a -> b) -> a -> b
$ Peeker e Name
forall e. Peeker e Name
peekName (CInt -> StackIndex
nth 2)
case Name -> Map Name (Property e a) -> Maybe (Property e a)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
propName Map Name (Property e a)
props Maybe (Property e a)
-> (Property e a -> Maybe (StackIndex -> a -> LuaE e a))
-> Maybe (StackIndex -> a -> LuaE e a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Property e a -> Maybe (StackIndex -> a -> LuaE e a)
forall e a. Property e a -> Maybe (StackIndex -> a -> LuaE e a)
propertySet of
Nothing -> Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop 1 LuaE e () -> LuaE e a -> LuaE e a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Map Name (Property e a) -> a -> LuaE e a
forall e a. LuaError e => Map Name (Property e a) -> a -> LuaE e a
setProperties Map Name (Property e a)
props a
x
Just setter :: StackIndex -> a -> LuaE e a
setter -> do
a
x' <- StackIndex -> a -> LuaE e a
setter StackIndex
top a
x
Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop 1
Map Name (Property e a) -> a -> LuaE e a
forall e a. LuaError e => Map Name (Property e a) -> a -> LuaE e a
setProperties Map Name (Property e a)
props a
x'
_ -> a
x a -> LuaE e () -> LuaE e a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop 1
setList :: forall itemtype e a. LuaError e
=> ListSpec e a itemtype -> a
-> Peek e a
setList :: ListSpec e a itemtype -> a -> Peek e a
setList (_pushspec :: (Pusher e itemtype, a -> [itemtype])
_pushspec, (peekItem :: Peeker e itemtype
peekItem, updateList :: a -> [itemtype] -> a
updateList)) x :: a
x = (a
x a -> [itemtype] -> a
`updateList`) ([itemtype] -> a) -> Peek e [itemtype] -> Peek e a
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> do
LuaE e Type -> Peek e Type
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> Name -> LuaE e Type
forall e. LuaError e => StackIndex -> Name -> LuaE e Type
getfield StackIndex
top "__lazylistindex") Peek e Type -> (Type -> Peek e [itemtype]) -> Peek e [itemtype]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
TypeBoolean -> do
LuaE e () -> Peek e ()
forall e a. LuaE e a -> Peek e a
liftLua (LuaE e () -> Peek e ()) -> LuaE e () -> Peek e ()
forall a b. (a -> b) -> a -> b
$ Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop 1
Peeker e itemtype -> Peeker e [itemtype]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e itemtype
peekItem StackIndex
top
_ -> do
let getLazyList :: Peek e [itemtype]
getLazyList = do
LuaE e Type -> Peek e Type
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> Name -> LuaE e Type
forall e. LuaError e => StackIndex -> Name -> LuaE e Type
getfield StackIndex
top "__lazylist") Peek e Type -> (Type -> Peek e ()) -> Peek e ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
TypeUserdata -> () -> Peek e ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
_ -> ByteString -> Peek e ()
forall a e. ByteString -> Peek e a
failPeek "unevaled items of lazy list cannot be peeked"
(Peek e [itemtype] -> LuaE e () -> Peek e [itemtype]
forall e a b. Peek e a -> LuaE e b -> Peek e a
`lastly` Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop 1) (Peek e [itemtype] -> Peek e [itemtype])
-> Peek e [itemtype] -> Peek e [itemtype]
forall a b. (a -> b) -> a -> b
$ Name
-> (StackIndex -> LuaE e (Maybe [itemtype])) -> Peeker e [itemtype]
forall e a. Name -> (StackIndex -> LuaE e (Maybe a)) -> Peeker e a
reportValueOnFailure
Name
lazyListStateName
(\idx :: StackIndex
idx -> StackIndex -> Name -> LuaE e (Maybe [itemtype])
forall a e. StackIndex -> Name -> LuaE e (Maybe a)
fromuserdata @[itemtype] StackIndex
idx Name
lazyListStateName)
StackIndex
top
Maybe Integer
mlastIndex <- LuaE e (Maybe Integer) -> Peek e (Maybe Integer)
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> LuaE e (Maybe Integer)
forall e. StackIndex -> LuaE e (Maybe Integer)
tointeger StackIndex
top LuaE e (Maybe Integer) -> LuaE e () -> LuaE e (Maybe Integer)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop 1)
let itemsAfter :: Integer -> Peek e [itemtype]
itemsAfter = case Maybe Integer
mlastIndex of
Nothing -> Peek e [itemtype] -> Integer -> Peek e [itemtype]
forall a b. a -> b -> a
const Peek e [itemtype]
getLazyList
Just lastIndex :: Integer
lastIndex -> \i :: Integer
i ->
if Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
lastIndex
then LuaE e Type -> Peek e Type
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> Integer -> LuaE e Type
forall e. LuaError e => StackIndex -> Integer -> LuaE e Type
rawgeti StackIndex
top Integer
i) Peek e Type -> (Type -> Peek e [itemtype]) -> Peek e [itemtype]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
TypeNil -> [] [itemtype] -> Peek e () -> Peek e [itemtype]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ LuaE e () -> Peek e ()
forall e a. LuaE e a -> Peek e a
liftLua (Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop 1)
_ -> do
itemtype
y <- Peeker e itemtype
peekItem StackIndex
top Peek e itemtype -> LuaE e () -> Peek e itemtype
forall e a b. Peek e a -> LuaE e b -> Peek e a
`lastly` Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop 1
(itemtype
yitemtype -> [itemtype] -> [itemtype]
forall a. a -> [a] -> [a]
:) ([itemtype] -> [itemtype])
-> Peek e [itemtype] -> Peek e [itemtype]
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Integer -> Peek e [itemtype]
itemsAfter (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ 1)
else Peek e [itemtype]
getLazyList
Integer -> Peek e [itemtype]
itemsAfter 1