{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module HsLua.ObjectOrientation
( UDType
, UDTypeWithList (..)
, deftypeGeneric
, deftypeGeneric'
, methodGeneric
, property
, property'
, possibleProperty
, possibleProperty'
, readonly
, readonly'
, alias
, peekUDGeneric
, pushUDGeneric
, initTypeGeneric
, udDocs
, udTypeSpec
, Member
, Property (..)
, Operation (..)
, ListSpec
, Possible (..)
, Alias
, AliasIndex (..)
) where
import Control.Monad ((<$!>), forM_, void, when)
import Data.Maybe (mapMaybe)
import Data.Map (Map)
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 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
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
, forall e a. Property e a -> TypeSpec
propertyType :: TypeSpec
}
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
-> TypeSpec
-> 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
-> TypeSpec
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property' Name
name TypeSpec
typespec 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
-> TypeSpec
-> Text
-> (Pusher e b, a -> Possible b)
-> (Peeker e b, a -> b -> Possible a)
-> Member e fn a
possibleProperty' Name
name TypeSpec
typespec 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))
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 = forall e b a fn.
LuaError e =>
Name
-> TypeSpec
-> Text
-> (Pusher e b, a -> Possible b)
-> (Peeker e b, a -> b -> Possible a)
-> Member e fn a
possibleProperty' Name
name TypeSpec
anyType
possibleProperty' :: LuaError e
=> Name
-> TypeSpec
-> 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
-> TypeSpec
-> Text
-> (Pusher e b, a -> Possible b)
-> (Peeker e b, a -> b -> Possible a)
-> Member e fn a
possibleProperty' Name
name TypeSpec
typespec 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
"."
, propertyType :: TypeSpec
propertyType = TypeSpec
typespec
, propertyDescription :: Text
propertyDescription = Text
desc
}
readonly' :: Name
-> TypeSpec
-> Text
-> (Pusher e b, a -> b)
-> Member e fn a
readonly' :: forall e b a fn.
Name -> TypeSpec -> Text -> (Pusher e b, a -> b) -> Member e fn a
readonly' Name
name TypeSpec
typespec 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
, propertyType :: TypeSpec
propertyType = TypeSpec
typespec
, 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 = forall e b a fn.
Name -> TypeSpec -> Text -> (Pusher e b, a -> b) -> Member e fn a
readonly' Name
name TypeSpec
anyType
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
initTypeGeneric :: LuaError e
=> (UDTypeWithList e fn a itemtype -> LuaE e ())
-> UDTypeWithList e fn a itemtype
-> LuaE e Name
initTypeGeneric :: forall e fn a itemtype.
LuaError e =>
(UDTypeWithList e fn a itemtype -> LuaE e ())
-> UDTypeWithList e fn a itemtype -> LuaE e Name
initTypeGeneric UDTypeWithList e fn a itemtype -> LuaE e ()
hook UDTypeWithList e fn a itemtype
ty = do
forall e fn a itemtype.
LuaError e =>
(UDTypeWithList e fn a itemtype -> LuaE e ())
-> UDTypeWithList e fn a itemtype -> LuaE e ()
pushUDMetatable UDTypeWithList e fn a itemtype -> LuaE e ()
hook UDTypeWithList e fn a itemtype
ty
forall e. Int -> LuaE e ()
pop Int
1
forall (m :: * -> *) a. Monad m => a -> m a
return (forall e fn a itemtype. UDTypeWithList e fn a itemtype -> Name
udName UDTypeWithList e fn a itemtype
ty)
pushUDMetatable :: LuaError e
=> (UDTypeWithList e fn a itemtype -> LuaE e ())
-> UDTypeWithList e fn a itemtype
-> LuaE e ()
pushUDMetatable :: forall e fn a itemtype.
LuaError e =>
(UDTypeWithList e fn a itemtype -> LuaE e ())
-> UDTypeWithList e fn a itemtype -> LuaE e ()
pushUDMetatable UDTypeWithList e fn a itemtype -> LuaE e ()
hook 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)
UDTypeWithList e fn a itemtype -> LuaE e ()
hook UDTypeWithList e fn a itemtype
ty
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
peekUDGeneric 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
peekUDGeneric 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"
pushUDGeneric :: LuaError e
=> (UDTypeWithList e fn a itemtype -> LuaE e ())
-> UDTypeWithList e fn a itemtype
-> a
-> LuaE e ()
pushUDGeneric :: forall e fn a itemtype.
LuaError e =>
(UDTypeWithList e fn a itemtype -> LuaE e ())
-> UDTypeWithList e fn a itemtype -> a -> LuaE e ()
pushUDGeneric UDTypeWithList e fn a itemtype -> LuaE e ()
pushDocs 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 ())
-> UDTypeWithList e fn a itemtype -> LuaE e ()
pushUDMetatable UDTypeWithList e fn a itemtype -> LuaE e ()
pushDocs 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)
peekUDGeneric :: LuaError e => UDTypeWithList e fn a itemtype -> Peeker e a
peekUDGeneric :: forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> Peeker e a
peekUDGeneric 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
udDocs :: UDTypeWithList e fn a itemtype
-> TypeDocs
udDocs :: forall e fn a itemtype. UDTypeWithList e fn a itemtype -> TypeDocs
udDocs UDTypeWithList e fn a itemtype
ty = TypeDocs
{ typeDescription :: Text
typeDescription = forall a. Monoid a => a
mempty
, typeSpec :: TypeSpec
typeSpec = TypeSpec
userdataType
, typeRegistry :: Maybe Name
typeRegistry = forall a. a -> Maybe a
Just (forall e fn a itemtype. UDTypeWithList e fn a itemtype -> Name
udName UDTypeWithList e fn a itemtype
ty)
}
udTypeSpec :: UDTypeWithList e fn a itemtype
-> TypeSpec
udTypeSpec :: forall e fn a itemtype. UDTypeWithList e fn a itemtype -> TypeSpec
udTypeSpec = Name -> TypeSpec
NamedType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e fn a itemtype. UDTypeWithList e fn a itemtype -> Name
udName