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