{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module HsLua.ObjectOrientation.Generic
( UDTypeGeneric (..)
, deftypeGeneric'
, methodGeneric
, property
, property'
, possibleProperty
, possibleProperty'
, readonly
, readonly'
, alias
, UDTypeHooks (..)
, emptyHooks
, peekUDGeneric
, pushUDGeneric
, initType
, udDocs
, udTypeSpec
, Member
, Property (..)
, Operation (..)
, 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 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 UDTypeGeneric e fn a = UDType
{ forall e fn a. UDTypeGeneric e fn a -> Name
udName :: Name
, forall e fn a. UDTypeGeneric e fn a -> [(Operation, fn)]
udOperations :: [(Operation, fn)]
, forall e fn a. UDTypeGeneric e fn a -> Map Name (Property e a)
udProperties :: Map Name (Property e a)
, forall e fn a. UDTypeGeneric e fn a -> Map Name fn
udMethods :: Map Name fn
, forall e fn a. UDTypeGeneric e fn a -> Map AliasIndex Alias
udAliases :: Map AliasIndex Alias
, forall e fn a. UDTypeGeneric e fn a -> UDTypeHooks e fn a
udHooks :: UDTypeHooks e fn a
, forall e fn a. UDTypeGeneric e fn a -> fn -> LuaE e ()
udFnPusher :: fn -> LuaE e ()
}
data UDTypeHooks e fn a =
UDTypeHooks
{ forall e fn a. UDTypeHooks e fn a -> Int
hookUservalues :: Int
, forall e fn a. UDTypeHooks e fn a -> LuaE e ()
hookMetatableSetup :: LuaE e ()
, forall e fn a. UDTypeHooks e fn a -> a -> StackIndex -> Peek e a
hookPeekUD :: a
-> StackIndex
-> Peek e a
, forall e fn a. UDTypeHooks e fn a -> a -> LuaE e ()
hookPushUD :: a -> LuaE e ()
}
emptyHooks :: UDTypeHooks e fn a
emptyHooks :: forall e fn a. UDTypeHooks e fn a
emptyHooks = UDTypeHooks
{ hookMetatableSetup :: LuaE e ()
hookMetatableSetup = () -> LuaE e ()
forall a. a -> LuaE e a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
, hookPeekUD :: a -> StackIndex -> Peek e a
hookPeekUD = \a
x StackIndex
_idx -> a -> Peek e a
forall a. a -> Peek e a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
, hookPushUD :: a -> LuaE e ()
hookPushUD = \a
_x -> () -> LuaE e ()
forall a. a -> LuaE e a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
, hookUservalues :: Int
hookUservalues = Int
1
}
deftypeGeneric' :: Pusher e fn
-> Name
-> [(Operation, fn)]
-> [Member e fn a]
-> UDTypeHooks e fn a
-> UDTypeGeneric e fn a
deftypeGeneric' :: forall e fn a.
Pusher e fn
-> Name
-> [(Operation, fn)]
-> [Member e fn a]
-> UDTypeHooks e fn a
-> UDTypeGeneric e fn a
deftypeGeneric' Pusher e fn
pushFunction Name
name [(Operation, fn)]
ops [Member e fn a]
members UDTypeHooks e fn a
extension = UDType
{ 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
, udHooks :: UDTypeHooks e fn a
udHooks = UDTypeHooks e fn a
extension
, 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 -> (Name, Property e a) -> Maybe (Name, Property e a)
forall a. a -> Maybe a
Just (Name
n, Property e a
p)
Member e fn a
_ -> Maybe (Name, Property e a)
forall a. Maybe a
Nothing
mbmethods :: Member e b a -> Maybe (Name, b)
mbmethods = \case
MemberMethod Name
n b
m -> (Name, b) -> Maybe (Name, b)
forall a. a -> Maybe a
Just (Name
n, b
m)
Member e b a
_ -> Maybe (Name, b)
forall a. Maybe a
Nothing
mbaliases :: Member e fn a -> Maybe (AliasIndex, Alias)
mbaliases = \case
MemberAlias AliasIndex
n Alias
a -> (AliasIndex, Alias) -> Maybe (AliasIndex, Alias)
forall a. a -> Maybe a
Just (AliasIndex
n, Alias
a)
Member e fn a
_ -> Maybe (AliasIndex, Alias)
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
(AliasIndex -> AliasIndex -> Bool)
-> (AliasIndex -> AliasIndex -> Bool) -> Eq AliasIndex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AliasIndex -> AliasIndex -> Bool
== :: AliasIndex -> AliasIndex -> Bool
$c/= :: AliasIndex -> AliasIndex -> Bool
/= :: 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
$ccompare :: AliasIndex -> AliasIndex -> Ordering
compare :: AliasIndex -> AliasIndex -> Ordering
$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
>= :: AliasIndex -> AliasIndex -> Bool
$cmax :: AliasIndex -> AliasIndex -> AliasIndex
max :: AliasIndex -> AliasIndex -> AliasIndex
$cmin :: AliasIndex -> AliasIndex -> AliasIndex
min :: AliasIndex -> AliasIndex -> 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 :: forall fn e a. 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
-> 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) =
Name
-> TypeSpec
-> 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
-> 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, 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 b
b -> a -> Possible a
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) =
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 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 :: 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 = Name
-> TypeSpec
-> 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
-> 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) =
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
$
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 NumResults -> LuaE e () -> LuaE e NumResults
forall a b. a -> LuaE e b -> LuaE e a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Pusher e b
push b
y
Possible b
Absent -> NumResults -> LuaE e NumResults
forall a. a -> LuaE e a
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> NumResults
NumResults CInt
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
$ \StackIndex
idx a
x -> do
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 set x value of
Actual a
y -> a -> LuaE e a
forall a. a -> LuaE e a
forall (m :: * -> *) a. Monad m => a -> m a
return a
y
Possible a
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
$ String
"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
<> 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) = 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
$
Property
{ propertyGet :: a -> LuaE e NumResults
propertyGet = \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 a. a -> LuaE e a
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> NumResults
NumResults CInt
1)
, propertySet :: Maybe (StackIndex -> a -> LuaE e a)
propertySet = Maybe (StackIndex -> a -> LuaE e a)
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 = Name -> TypeSpec -> Text -> (Pusher e b, a -> b) -> Member e fn a
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 = AliasIndex -> Alias -> Member e fn a
forall e fn a. AliasIndex -> Alias -> Member e fn a
MemberAlias AliasIndex
name
initType :: LuaError e
=> UDTypeGeneric e fn a
-> LuaE e Name
initType :: forall e fn a. LuaError e => UDTypeGeneric e fn a -> LuaE e Name
initType UDTypeGeneric e fn a
ty = do
UDTypeGeneric e fn a -> LuaE e ()
forall e fn a. LuaError e => UDTypeGeneric e fn a -> LuaE e ()
pushUDMetatable UDTypeGeneric e fn a
ty
Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop Int
1
Name -> LuaE e Name
forall a. a -> LuaE e a
forall (m :: * -> *) a. Monad m => a -> m a
return (UDTypeGeneric e fn a -> Name
forall e fn a. UDTypeGeneric e fn a -> Name
udName UDTypeGeneric e fn a
ty)
pushUDMetatable
:: forall e fn a. LuaError e
=> UDTypeGeneric e fn a
-> LuaE e ()
pushUDMetatable :: forall e fn a. LuaError e => UDTypeGeneric e fn a -> LuaE e ()
pushUDMetatable UDTypeGeneric e fn a
ty = do
created <- Name -> LuaE e Bool
forall e. Name -> LuaE e Bool
newudmetatable (UDTypeGeneric e fn a -> Name
forall e fn a. UDTypeGeneric e fn a -> Name
udName UDTypeGeneric e fn a
ty)
when created $ do
add (metamethodName Index) $ pushcfunction hslua_udindex_ptr
add (metamethodName Newindex) $ pushcfunction hslua_udnewindex_ptr
add (metamethodName Pairs) $ pushHaskellFunction (pairsFunction ty)
forM_ (udOperations ty) $ \(Operation
op, fn
f) -> do
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
$ UDTypeGeneric e fn a -> fn -> LuaE e ()
forall e fn a. UDTypeGeneric e fn a -> fn -> LuaE e ()
udFnPusher UDTypeGeneric e fn a
ty fn
f
add "getters" $ pushGetters ty
add "setters" $ pushSetters ty
add "methods" $ pushMethods ty
add "aliases" $ pushAliases ty
hookMetatableSetup (udHooks ty)
where
add :: Name -> LuaE e () -> LuaE e ()
add :: Name -> LuaE e () -> LuaE e ()
add Name
name 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 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
=> UDTypeGeneric e fn a -> LuaE e ()
pushGetters :: forall e fn a. LuaError e => UDTypeGeneric e fn a -> LuaE e ()
pushGetters UDTypeGeneric e fn a
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 (UDTypeGeneric e fn a -> Map Name (Property e a)
forall e fn a. UDTypeGeneric e fn a -> Map Name (Property e a)
udProperties UDTypeGeneric e fn a
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 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 (UDTypeGeneric e fn a -> Peeker e a
forall e fn a. LuaError e => UDTypeGeneric e fn a -> Peeker e a
peekUDGeneric UDTypeGeneric e fn a
ty StackIndex
1) LuaE e a -> (a -> HaskellFunction e) -> HaskellFunction e
forall a b. LuaE e a -> (a -> LuaE e b) -> LuaE e b
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 CInt
3)
pushSetters :: LuaError e => UDTypeGeneric e fn a -> LuaE e ()
pushSetters :: forall e fn a. LuaError e => UDTypeGeneric e fn a -> LuaE e ()
pushSetters UDTypeGeneric e fn a
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 (UDTypeGeneric e fn a -> Map Name (Property e a)
forall e fn a. UDTypeGeneric e fn a -> Map Name (Property e a)
udProperties UDTypeGeneric e fn a
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 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 StackIndex -> a -> LuaE e a
_ -> CFunction
hslua_udsetter_ptr
Maybe (StackIndex -> a -> LuaE e a)
Nothing -> CFunction
hslua_udreadonly_ptr
StackIndex -> LuaE e ()
forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth CInt
3)
pushMethods :: LuaError e => UDTypeGeneric e fn a -> LuaE e ()
pushMethods :: forall e fn a. LuaError e => UDTypeGeneric e fn a -> LuaE e ()
pushMethods UDTypeGeneric e fn a
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 (UDTypeGeneric e fn a -> Map Name fn
forall e fn a. UDTypeGeneric e fn a -> Map Name fn
udMethods UDTypeGeneric e fn a
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 fn
fn -> do
Name -> LuaE e ()
forall e. Name -> LuaE e ()
pushName Name
name
UDTypeGeneric e fn a -> fn -> LuaE e ()
forall e fn a. UDTypeGeneric e fn a -> fn -> LuaE e ()
udFnPusher UDTypeGeneric e fn a
ty fn
fn
StackIndex -> LuaE e ()
forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth CInt
3)
pushAliases :: LuaError e => UDTypeGeneric e fn a -> LuaE e ()
pushAliases :: forall e fn a. LuaError e => UDTypeGeneric e fn a -> LuaE e ()
pushAliases UDTypeGeneric e fn a
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 (UDTypeGeneric e fn a -> Map AliasIndex Alias
forall e fn a. UDTypeGeneric e fn a -> Map AliasIndex Alias
udAliases UDTypeGeneric e fn a
ty) ((AliasIndex -> Alias -> LuaE e ()) -> LuaE e (Map AliasIndex ()))
-> (AliasIndex -> Alias -> LuaE e ()) -> LuaE e (Map AliasIndex ())
forall a b. (a -> b) -> a -> b
$ \AliasIndex
name 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 CInt
3)
pushAliasIndex :: Pusher e AliasIndex
pushAliasIndex :: forall e. Pusher e AliasIndex
pushAliasIndex = \case
StringIndex Name
name -> Name -> LuaE e ()
forall e. Name -> LuaE e ()
pushName Name
name
IntegerIndex Integer
n -> Integer -> LuaE e ()
forall a e. (Integral a, Show a) => a -> LuaE e ()
pushIntegral Integer
n
pairsFunction
:: LuaError err
=> UDTypeGeneric err fn a -> LuaE err NumResults
pairsFunction :: forall err fn a.
LuaError err =>
UDTypeGeneric err fn a -> LuaE err NumResults
pairsFunction UDTypeGeneric err fn a
ty = do
obj <- Peek err a -> LuaE err a
forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek (Peek err a -> LuaE err a) -> Peek err a -> LuaE err a
forall a b. (a -> b) -> a -> b
$ UDTypeGeneric err fn a -> Peeker err a
forall e fn a. LuaError e => UDTypeGeneric e fn a -> Peeker e a
peekUDGeneric UDTypeGeneric err fn a
ty (CInt -> StackIndex
nthBottom CInt
1)
let pushMember = \case
MemberProperty Name
name Property err a
prop -> do
Name -> LuaE err ()
forall e. Name -> LuaE e ()
pushName Name
name
getresults <- Property err a -> a -> LuaE err NumResults
forall e a. Property e a -> a -> LuaE e NumResults
propertyGet Property err a
prop a
obj
if getresults == 0
then 0 <$ pop 1
else return $ getresults + 1
MemberMethod Name
name fn
f -> do
Name -> LuaE err ()
forall e. Name -> LuaE e ()
pushName Name
name
UDTypeGeneric err fn a -> fn -> LuaE err ()
forall e fn a. UDTypeGeneric e fn a -> fn -> LuaE e ()
udFnPusher UDTypeGeneric err fn a
ty fn
f
NumResults -> LuaE err NumResults
forall a. a -> LuaE err a
forall (m :: * -> *) a. Monad m => a -> m a
return NumResults
2
MemberAlias{} -> String -> LuaE err NumResults
forall a. String -> LuaE err a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"aliases are not full properties"
pushIterator pushMember $
map (uncurry MemberProperty) (Map.toAscList (udProperties ty)) ++
map (uncurry MemberMethod) (Map.toAscList (udMethods ty))
pushUDGeneric
:: LuaError e
=> UDTypeGeneric e fn a
-> a
-> LuaE e ()
pushUDGeneric :: forall e fn a. LuaError e => UDTypeGeneric e fn a -> a -> LuaE e ()
pushUDGeneric UDTypeGeneric e fn a
ty a
x = do
a -> Int -> LuaE e ()
forall a e. a -> Int -> LuaE e ()
newhsuserdatauv a
x (UDTypeHooks e fn a -> Int
forall e fn a. UDTypeHooks e fn a -> Int
hookUservalues (UDTypeGeneric e fn a -> UDTypeHooks e fn a
forall e fn a. UDTypeGeneric e fn a -> UDTypeHooks e fn a
udHooks UDTypeGeneric e fn a
ty))
UDTypeGeneric e fn a -> LuaE e ()
forall e fn a. LuaError e => UDTypeGeneric e fn a -> LuaE e ()
pushUDMetatable UDTypeGeneric e fn a
ty
StackIndex -> LuaE e ()
forall e. StackIndex -> LuaE e ()
setmetatable (CInt -> StackIndex
nth CInt
2)
UDTypeHooks e fn a -> a -> LuaE e ()
forall e fn a. UDTypeHooks e fn a -> a -> LuaE e ()
hookPushUD (UDTypeGeneric e fn a -> UDTypeHooks e fn a
forall e fn a. UDTypeGeneric e fn a -> UDTypeHooks e fn a
udHooks UDTypeGeneric e fn a
ty) a
x
peekUDGeneric :: LuaError e
=> UDTypeGeneric e fn a -> Peeker e a
peekUDGeneric :: forall e fn a. LuaError e => UDTypeGeneric e fn a -> Peeker e a
peekUDGeneric UDTypeGeneric e fn a
ty StackIndex
idx = do
let name :: Name
name = UDTypeGeneric e fn a -> Name
forall e fn a. UDTypeGeneric e fn a -> Name
udName UDTypeGeneric e fn a
ty
old <- 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
updated <- liftLua (getiuservalue idx 1) >>= \case
Type
TypeTable -> 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 (UDTypeGeneric e fn a -> Map Name (Property e a)
forall e fn a. UDTypeGeneric e fn a -> Map Name (Property e a)
udProperties UDTypeGeneric e fn a
ty) a
old
Type
_other -> a -> Peek e a
forall a. a -> Peek e a
forall (m :: * -> *) a. Monad m => a -> m a
return a
old
liftLua $ pop 1
hookPeekUD (udHooks ty) updated idx
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
hasNext <- StackIndex -> LuaE e Bool
forall e. StackIndex -> LuaE e Bool
Unsafe.next (CInt -> StackIndex
nth CInt
2)
let continue a
value = Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop Int
1 LuaE e () -> LuaE e a -> LuaE e a
forall a b. LuaE e a -> LuaE e b -> LuaE e b
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
value
if not hasNext
then return x
else ltype (nth 2) >>= \case
Type
TypeString -> do
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 CInt
2)
case Map.lookup propName props >>= propertySet of
Maybe (StackIndex -> a -> LuaE e a)
Nothing -> a -> LuaE e a
continue a
x
Just StackIndex -> a -> LuaE e a
setter -> do
x' <- StackIndex -> a -> LuaE e a
setter StackIndex
top a
x
continue x'
Type
_ -> a -> LuaE e a
continue a
x
udDocs :: UDTypeGeneric e fn a
-> TypeDocs
udDocs :: forall e fn a. UDTypeGeneric e fn a -> TypeDocs
udDocs UDTypeGeneric e fn a
ty = TypeDocs
{ typeDescription :: Text
typeDescription = Text
forall a. Monoid a => a
mempty
, typeSpec :: TypeSpec
typeSpec = TypeSpec
userdataType
, typeRegistry :: Maybe Name
typeRegistry = Name -> Maybe Name
forall a. a -> Maybe a
Just (UDTypeGeneric e fn a -> Name
forall e fn a. UDTypeGeneric e fn a -> Name
udName UDTypeGeneric e fn a
ty)
}
udTypeSpec :: UDTypeGeneric e fn a
-> TypeSpec
udTypeSpec :: forall e fn a. UDTypeGeneric e fn a -> TypeSpec
udTypeSpec = Name -> TypeSpec
NamedType (Name -> TypeSpec)
-> (UDTypeGeneric e fn a -> Name)
-> UDTypeGeneric e fn a
-> TypeSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UDTypeGeneric e fn a -> Name
forall e fn a. UDTypeGeneric e fn a -> Name
udName