{-# LANGUAGE CPP                 #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}
{-|
Module      : HsLua.ObjectOrientation
Copyright   : © 2021-2022 Albert Krewinkel
License     : MIT
Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de>

This module provides types and functions to use Haskell values as
userdata objects in Lua. These objects wrap a Haskell value and provide
methods and properties to interact with the Haskell value.

The terminology in this module refers to the userdata values as /UD
objects/, and to their type as /UD type/.
-}
module HsLua.ObjectOrientation
  ( UDType
  , UDTypeWithList (..)
  , deftypeGeneric
  , deftypeGeneric'
  , methodGeneric
  , property
  , possibleProperty
  , readonly
  , alias
  , peekUD
  , pushUD
    -- * Helper types for building
  , Member
  , Property
  , Operation (..)
  , ListSpec
  , Possible (..)
  , Alias
  , AliasIndex (..)
  ) where

import Control.Monad.Except
import Foreign.Ptr (FunPtr)
import Data.Maybe (mapMaybe)
import Data.Map (Map)
#if !MIN_VERSION_base(4,12,0)
import Data.Semigroup (Semigroup ((<>)))
#endif
import Data.String (IsString (..))
import Data.Text (Text)
import Data.Void (Void)
import HsLua.Core as Lua
import HsLua.Marshalling
import HsLua.ObjectOrientation.Operation
import qualified Data.Map.Strict as Map
import qualified HsLua.Core.Unsafe as Unsafe
import qualified HsLua.Core.Utf8 as Utf8

-- | A userdata type, capturing the behavior of Lua objects that wrap
-- Haskell values. The type name must be unique; once the type has been
-- used to push or retrieve a value, the behavior can no longer be
-- modified through this type.
--
-- This type includes methods to define how the object should behave as
-- a read-only list of type @itemtype@.
data UDTypeWithList e fn a itemtype = UDTypeWithList
  { UDTypeWithList e fn a itemtype -> Name
udName          :: Name
  , UDTypeWithList e fn a itemtype -> [(Operation, fn)]
udOperations    :: [(Operation, fn)]
  , UDTypeWithList e fn a itemtype -> Map Name (Property e a)
udProperties    :: Map Name (Property e a)
  , UDTypeWithList e fn a itemtype -> Map Name fn
udMethods       :: Map Name fn
  , UDTypeWithList e fn a itemtype -> Map AliasIndex Alias
udAliases       :: Map AliasIndex Alias
  , UDTypeWithList e fn a itemtype -> Maybe (ListSpec e a itemtype)
udListSpec      :: Maybe (ListSpec e a itemtype)
  , UDTypeWithList e fn a itemtype -> fn -> LuaE e ()
udFnPusher      :: fn -> LuaE e ()
  }

-- | Pair of pairs, describing how a type can be used as a Lua list. The
-- first pair describes how to push the list items, and how the list is
-- extracted from the type; the second pair contains a method to
-- retrieve list items, and defines how the list is used to create an
-- updated value.
type ListSpec e a itemtype =
  ( (Pusher e itemtype, a -> [itemtype])
  , (Peeker e itemtype, a -> [itemtype] -> a)
  )

-- | A userdata type, capturing the behavior of Lua objects that wrap
-- Haskell values. The type name must be unique; once the type has been
-- used to push or retrieve a value, the behavior can no longer be
-- modified through this type.
type UDType e fn a = UDTypeWithList e fn a Void

-- | Defines a new type, defining the behavior of objects in Lua.
-- Note that the type name must be unique.
deftypeGeneric :: Pusher e fn           -- ^ function pusher
               -> Name                  -- ^ type name
               -> [(Operation, fn)]     -- ^ operations
               -> [Member e fn a]       -- ^ methods
               -> UDType e fn a
deftypeGeneric :: 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 =
  Pusher e fn
-> Name
-> [(Operation, fn)]
-> [Member e fn a]
-> Maybe (ListSpec e a Void)
-> UDType e fn a
forall e fn a itemtype.
Pusher e fn
-> Name
-> [(Operation, fn)]
-> [Member e fn a]
-> Maybe (ListSpec e a itemtype)
-> UDTypeWithList e fn a itemtype
deftypeGeneric' Pusher e fn
pushFunction Name
name [(Operation, fn)]
ops [Member e fn a]
members Maybe (ListSpec e a Void)
forall a. Maybe a
Nothing

-- | Defines a new type that could also be treated as a list; defines
-- the behavior of objects in Lua. Note that the type name must be
-- unique.
deftypeGeneric' :: Pusher e fn          -- ^ function pusher
                -> Name                 -- ^ type name
                -> [(Operation, fn)]    -- ^ operations
                -> [Member e fn a]      -- ^ methods
                -> Maybe (ListSpec e a itemtype)  -- ^ list access
                -> UDTypeWithList e fn a itemtype
deftypeGeneric' :: Pusher e fn
-> Name
-> [(Operation, fn)]
-> [Member e fn a]
-> Maybe (ListSpec e a itemtype)
-> UDTypeWithList e fn a itemtype
deftypeGeneric' Pusher e fn
pushFunction Name
name [(Operation, fn)]
ops [Member e fn a]
members Maybe (ListSpec e a itemtype)
mbListSpec = UDTypeWithList :: forall e fn a itemtype.
Name
-> [(Operation, fn)]
-> Map Name (Property e a)
-> Map Name fn
-> Map AliasIndex Alias
-> Maybe (ListSpec e a itemtype)
-> (fn -> LuaE e ())
-> UDTypeWithList e fn a itemtype
UDTypeWithList
  { udName :: Name
udName          = Name
name
  , udOperations :: [(Operation, fn)]
udOperations    = [(Operation, fn)]
ops
  , udProperties :: Map Name (Property e a)
udProperties    = [(Name, Property e a)] -> Map Name (Property e a)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Name, Property e a)] -> Map Name (Property e a))
-> [(Name, Property e a)] -> Map Name (Property e a)
forall a b. (a -> b) -> a -> b
$ (Member e fn a -> Maybe (Name, Property e a))
-> [Member e fn a] -> [(Name, Property e a)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Member e fn a -> Maybe (Name, Property e a)
forall e fn a. Member e fn a -> Maybe (Name, Property e a)
mbproperties [Member e fn a]
members
  , udMethods :: Map Name fn
udMethods       = [(Name, fn)] -> Map Name fn
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Name, fn)] -> Map Name fn) -> [(Name, fn)] -> Map Name fn
forall a b. (a -> b) -> a -> b
$ (Member e fn a -> Maybe (Name, fn))
-> [Member e fn a] -> [(Name, fn)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Member e fn a -> Maybe (Name, fn)
forall e b a. Member e b a -> Maybe (Name, b)
mbmethods [Member e fn a]
members
  , udAliases :: Map AliasIndex Alias
udAliases       = [(AliasIndex, Alias)] -> Map AliasIndex Alias
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(AliasIndex, Alias)] -> Map AliasIndex Alias)
-> [(AliasIndex, Alias)] -> Map AliasIndex Alias
forall a b. (a -> b) -> a -> b
$ (Member e fn a -> Maybe (AliasIndex, Alias))
-> [Member e fn a] -> [(AliasIndex, Alias)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Member e fn a -> Maybe (AliasIndex, Alias)
forall e fn a. Member e fn a -> Maybe (AliasIndex, Alias)
mbaliases [Member e fn a]
members
  , udListSpec :: Maybe (ListSpec e a itemtype)
udListSpec      = Maybe (ListSpec e a itemtype)
mbListSpec
  , udFnPusher :: Pusher e fn
udFnPusher      = Pusher e fn
pushFunction
  }
  where
    mbproperties :: Member e fn a -> Maybe (Name, Property e a)
mbproperties = \case
      MemberProperty 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

-- | A read- and writable property on a UD object.
data Property e a = Property
  { Property e a -> a -> LuaE e NumResults
propertyGet :: a -> LuaE e NumResults
  , Property e a -> Maybe (StackIndex -> a -> LuaE e a)
propertySet :: Maybe (StackIndex -> a -> LuaE e a)
  , Property e a -> Text
propertyDescription :: Text
  }

-- | Alias for a different property of this or of a nested object.
type Alias = [AliasIndex]

-- | Index types allowed in aliases (strings and integers)
data AliasIndex
  = StringIndex Name
  | IntegerIndex Lua.Integer
  deriving (AliasIndex -> AliasIndex -> Bool
(AliasIndex -> AliasIndex -> Bool)
-> (AliasIndex -> AliasIndex -> Bool) -> Eq AliasIndex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AliasIndex -> AliasIndex -> Bool
$c/= :: AliasIndex -> AliasIndex -> Bool
== :: AliasIndex -> AliasIndex -> Bool
$c== :: AliasIndex -> AliasIndex -> Bool
Eq, Eq AliasIndex
Eq AliasIndex
-> (AliasIndex -> AliasIndex -> Ordering)
-> (AliasIndex -> AliasIndex -> Bool)
-> (AliasIndex -> AliasIndex -> Bool)
-> (AliasIndex -> AliasIndex -> Bool)
-> (AliasIndex -> AliasIndex -> Bool)
-> (AliasIndex -> AliasIndex -> AliasIndex)
-> (AliasIndex -> AliasIndex -> AliasIndex)
-> Ord AliasIndex
AliasIndex -> AliasIndex -> Bool
AliasIndex -> AliasIndex -> Ordering
AliasIndex -> AliasIndex -> AliasIndex
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AliasIndex -> AliasIndex -> AliasIndex
$cmin :: AliasIndex -> AliasIndex -> AliasIndex
max :: AliasIndex -> AliasIndex -> AliasIndex
$cmax :: AliasIndex -> AliasIndex -> AliasIndex
>= :: AliasIndex -> AliasIndex -> Bool
$c>= :: AliasIndex -> AliasIndex -> Bool
> :: AliasIndex -> AliasIndex -> Bool
$c> :: AliasIndex -> AliasIndex -> Bool
<= :: AliasIndex -> AliasIndex -> Bool
$c<= :: AliasIndex -> AliasIndex -> Bool
< :: AliasIndex -> AliasIndex -> Bool
$c< :: AliasIndex -> AliasIndex -> Bool
compare :: AliasIndex -> AliasIndex -> Ordering
$ccompare :: AliasIndex -> AliasIndex -> Ordering
$cp1Ord :: Eq AliasIndex
Ord)

instance IsString AliasIndex where
  fromString :: String -> AliasIndex
fromString = Name -> AliasIndex
StringIndex (Name -> AliasIndex) -> (String -> Name) -> String -> AliasIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Name
forall a. IsString a => String -> a
fromString

-- | A type member, either a method or a variable.
data Member e fn a
  = MemberProperty Name (Property e a)
  | MemberMethod Name fn
  | MemberAlias AliasIndex Alias

-- | Use a documented function as an object method.
methodGeneric :: Name -> fn -> Member e fn a
methodGeneric :: Name -> fn -> Member e fn a
methodGeneric = Name -> fn -> Member e fn a
forall e fn a. Name -> fn -> Member e fn a
MemberMethod

-- | A property or method which may be available in some instances but
-- not in others.
data Possible a
  = Actual a
  | Absent

-- | Declares a new read- and writable property.
property :: LuaError e
         => Name                       -- ^ property name
         -> Text                       -- ^ property description
         -> (Pusher e b, a -> b)       -- ^ how to get the property value
         -> (Peeker e b, a -> b -> a)  -- ^ how to set a new property value
         -> Member e fn a
property :: Name
-> 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))

-- | Declares a new read- and writable property which is not always
-- available.
possibleProperty :: LuaError e
  => Name                               -- ^ property name
  -> Text                               -- ^ property description
  -> (Pusher e b, a -> Possible b)      -- ^ how to get the property value
  -> (Peeker e b, a -> b -> Possible a) -- ^ how to set a new property value
  -> Member e fn a
possibleProperty :: Name
-> 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) = 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 :: forall e a.
(a -> LuaE e NumResults)
-> Maybe (StackIndex -> a -> LuaE e a) -> Text -> Property e a
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 (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Pusher e b
push b
y
        Possible b
Absent   -> NumResults -> LuaE e NumResults
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
      b
value  <- Peek e b -> LuaE e b
forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek (Peek e b -> LuaE e b) -> Peek e b -> LuaE e b
forall a b. (a -> b) -> a -> b
$ Peeker e b
peek StackIndex
idx
      case a -> b -> Possible a
set a
x b
value of
        Actual a
y -> 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
"."
  , propertyDescription :: Text
propertyDescription = Text
desc
  }

-- | Creates a read-only object property. Attempts to set the value will
-- cause an error.
readonly :: Name                 -- ^ property name
         -> Text                 -- ^ property description
         -> (Pusher e b, a -> b) -- ^ how to get the property value
         -> Member e fn a
readonly :: Name -> Text -> (Pusher e b, a -> b) -> Member e fn a
readonly Name
name 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 :: forall e a.
(a -> LuaE e NumResults)
-> Maybe (StackIndex -> a -> LuaE e a) -> Text -> Property e a
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 (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
  , propertyDescription :: Text
propertyDescription = Text
desc
  }

-- | Define an alias for another, possibly nested, property.
alias :: AliasIndex    -- ^ property alias
      -> Text          -- ^ description
      -> [AliasIndex]  -- ^ sequence of nested properties
      -> Member e fn a
alias :: 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

-- | Pushes the metatable for the given type to the Lua stack. Creates
-- the new table afresh on the first time it is needed, and retrieves it
-- from the registry after that.
pushUDMetatable :: LuaError e => UDTypeWithList e fn a itemtype -> LuaE e ()
pushUDMetatable :: UDTypeWithList e fn a itemtype -> LuaE e ()
pushUDMetatable UDTypeWithList e fn a itemtype
ty = do
  Bool
created <- Name -> LuaE e Bool
forall e. Name -> LuaE e Bool
newudmetatable (UDTypeWithList e fn a itemtype -> Name
forall e fn a itemtype. UDTypeWithList e fn a itemtype -> Name
udName UDTypeWithList e fn a itemtype
ty)
  Bool -> LuaE e () -> LuaE e ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
created (LuaE e () -> LuaE e ()) -> LuaE e () -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ do
    Name -> LuaE e () -> LuaE e ()
forall e. LuaError e => Name -> LuaE e () -> LuaE e ()
add (Operation -> Name
metamethodName Operation
Index)    (LuaE e () -> LuaE e ()) -> LuaE e () -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ CFunction -> LuaE e ()
forall e. CFunction -> LuaE e ()
pushcfunction CFunction
hslua_udindex_ptr
    Name -> LuaE e () -> LuaE e ()
forall e. LuaError e => Name -> LuaE e () -> LuaE e ()
add (Operation -> Name
metamethodName Operation
Newindex) (LuaE e () -> LuaE e ()) -> LuaE e () -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ CFunction -> LuaE e ()
forall e. CFunction -> LuaE e ()
pushcfunction CFunction
hslua_udnewindex_ptr
    Name -> LuaE e () -> LuaE e ()
forall e. LuaError e => Name -> LuaE e () -> LuaE e ()
add (Operation -> Name
metamethodName Operation
Pairs)    (LuaE e () -> LuaE e ()) -> LuaE e () -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ HaskellFunction e -> LuaE e ()
forall e. LuaError e => HaskellFunction e -> LuaE e ()
pushHaskellFunction (UDTypeWithList e fn a itemtype -> HaskellFunction e
forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> LuaE e NumResults
pairsFunction UDTypeWithList e fn a itemtype
ty)
    [(Operation, fn)] -> ((Operation, fn) -> LuaE e ()) -> LuaE e ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (UDTypeWithList e fn a itemtype -> [(Operation, fn)]
forall e fn a itemtype.
UDTypeWithList e fn a itemtype -> [(Operation, fn)]
udOperations UDTypeWithList e fn a itemtype
ty) (((Operation, fn) -> LuaE e ()) -> LuaE e ())
-> ((Operation, fn) -> LuaE e ()) -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ \(Operation
op, fn
f) -> do
      Name -> LuaE e () -> LuaE e ()
forall e. LuaError e => Name -> LuaE e () -> LuaE e ()
add (Operation -> Name
metamethodName Operation
op) (LuaE e () -> LuaE e ()) -> LuaE e () -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ UDTypeWithList e fn a itemtype -> fn -> LuaE e ()
forall e fn a itemtype.
UDTypeWithList e fn a itemtype -> fn -> LuaE e ()
udFnPusher UDTypeWithList e fn a itemtype
ty fn
f
    Name -> LuaE e () -> LuaE e ()
forall e. LuaError e => Name -> LuaE e () -> LuaE e ()
add Name
"getters" (LuaE e () -> LuaE e ()) -> LuaE e () -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ UDTypeWithList e fn a itemtype -> LuaE e ()
forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> LuaE e ()
pushGetters UDTypeWithList e fn a itemtype
ty
    Name -> LuaE e () -> LuaE e ()
forall e. LuaError e => Name -> LuaE e () -> LuaE e ()
add Name
"setters" (LuaE e () -> LuaE e ()) -> LuaE e () -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ UDTypeWithList e fn a itemtype -> LuaE e ()
forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> LuaE e ()
pushSetters UDTypeWithList e fn a itemtype
ty
    Name -> LuaE e () -> LuaE e ()
forall e. LuaError e => Name -> LuaE e () -> LuaE e ()
add Name
"methods" (LuaE e () -> LuaE e ()) -> LuaE e () -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ UDTypeWithList e fn a itemtype -> LuaE e ()
forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> LuaE e ()
pushMethods UDTypeWithList e fn a itemtype
ty
    Name -> LuaE e () -> LuaE e ()
forall e. LuaError e => Name -> LuaE e () -> LuaE e ()
add Name
"aliases" (LuaE e () -> LuaE e ()) -> LuaE e () -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ UDTypeWithList e fn a itemtype -> LuaE e ()
forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> LuaE e ()
pushAliases UDTypeWithList e fn a itemtype
ty
    case UDTypeWithList e fn a itemtype -> Maybe (ListSpec e a itemtype)
forall e fn a itemtype.
UDTypeWithList e fn a itemtype -> Maybe (ListSpec e a itemtype)
udListSpec UDTypeWithList e fn a itemtype
ty of
      Maybe (ListSpec e a itemtype)
Nothing -> () -> LuaE e ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Just ((Pusher e itemtype
pushItem, a -> [itemtype]
_), (Peeker e itemtype, a -> [itemtype] -> a)
_) -> do
        Name -> LuaE e () -> LuaE e ()
forall e. LuaError e => Name -> LuaE e () -> LuaE e ()
add Name
"lazylisteval" (LuaE e () -> LuaE e ()) -> LuaE e () -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ HaskellFunction e -> LuaE e ()
forall e. LuaError e => HaskellFunction e -> LuaE e ()
pushHaskellFunction (Pusher e itemtype -> HaskellFunction e
forall itemtype e.
LuaError e =>
Pusher e itemtype -> LuaE e NumResults
lazylisteval Pusher e itemtype
pushItem)
  where
    add :: LuaError e => Name -> LuaE e () -> LuaE e ()
    add :: Name -> LuaE e () -> LuaE e ()
add Name
name 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)

-- | Retrieves a key from a Haskell-data holding userdata value.
--
-- Does the following, in order, and returns the first non-nil result:
--
--   - Checks the userdata's uservalue table for the given key;
--
--   - Looks up a @getter@ for the key and calls it with the userdata
--     and key as arguments;
--
--   - Looks up the key in the table in the @methods@ metafield.
foreign import ccall "hslobj.c &hslua_udindex"
  hslua_udindex_ptr :: FunPtr (State -> IO NumResults)

-- | Sets a new value in the userdata caching table via a setter
-- functions.
--
-- The actual assignment is performed by a setter function stored in the
-- @setter@ metafield. Throws an error if no setter function can be
-- found.
foreign import ccall "hslobj.c &hslua_udnewindex"
  hslua_udnewindex_ptr :: FunPtr (State -> IO NumResults)

-- | Sets a value in the userdata's caching table (uservalue). Takes the
-- same arguments as a @__newindex@ function.
foreign import ccall "hslobj.c &hslua_udsetter"
  hslua_udsetter_ptr :: FunPtr (State -> IO NumResults)

-- | Throws an error nothing that the given key is read-only.
foreign import ccall "hslobj.c &hslua_udreadonly"
  hslua_udreadonly_ptr :: FunPtr (State -> IO NumResults)

-- | Pushes the metatable's @getters@ field table.
pushGetters :: LuaError e => UDTypeWithList e fn a itemtype -> LuaE e ()
pushGetters :: UDTypeWithList e fn a itemtype -> LuaE e ()
pushGetters UDTypeWithList e fn a itemtype
ty = do
  LuaE e ()
forall e. LuaE e ()
newtable
  LuaE e (Map Name ()) -> LuaE e ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (LuaE e (Map Name ()) -> LuaE e ())
-> LuaE e (Map Name ()) -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ ((Name -> Property e a -> LuaE e ())
 -> Map Name (Property e a) -> LuaE e (Map Name ()))
-> Map Name (Property e a)
-> (Name -> Property e a -> LuaE e ())
-> LuaE e (Map Name ())
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Name -> Property e a -> LuaE e ())
-> Map Name (Property e a) -> LuaE e (Map Name ())
forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
Map.traverseWithKey (UDTypeWithList e fn a itemtype -> Map Name (Property e a)
forall e fn a itemtype.
UDTypeWithList e fn a itemtype -> Map Name (Property e a)
udProperties UDTypeWithList e fn a itemtype
ty) ((Name -> Property e a -> LuaE e ()) -> LuaE e (Map Name ()))
-> (Name -> Property e a -> LuaE e ()) -> LuaE e (Map Name ())
forall a b. (a -> b) -> a -> b
$ \Name
name Property e a
prop -> do
    Name -> LuaE e ()
forall e. Name -> LuaE e ()
pushName Name
name
    HaskellFunction e -> LuaE e ()
forall e. LuaError e => HaskellFunction e -> LuaE e ()
pushHaskellFunction (HaskellFunction e -> LuaE e ()) -> HaskellFunction e -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ Peek e a -> LuaE e a
forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek (UDTypeWithList e fn a itemtype -> Peeker e a
forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> Peeker e a
peekUD UDTypeWithList e fn a itemtype
ty StackIndex
1) LuaE e a -> (a -> HaskellFunction e) -> HaskellFunction e
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Property e a -> a -> HaskellFunction e
forall e a. Property e a -> a -> LuaE e NumResults
propertyGet Property e a
prop
    StackIndex -> LuaE e ()
forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth CInt
3)

-- | Pushes the metatable's @setters@ field table.
pushSetters :: LuaError e => UDTypeWithList e fn a itemtype -> LuaE e ()
pushSetters :: UDTypeWithList e fn a itemtype -> LuaE e ()
pushSetters UDTypeWithList e fn a itemtype
ty = do
  LuaE e ()
forall e. LuaE e ()
newtable
  LuaE e (Map Name ()) -> LuaE e ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (LuaE e (Map Name ()) -> LuaE e ())
-> LuaE e (Map Name ()) -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ ((Name -> Property e a -> LuaE e ())
 -> Map Name (Property e a) -> LuaE e (Map Name ()))
-> Map Name (Property e a)
-> (Name -> Property e a -> LuaE e ())
-> LuaE e (Map Name ())
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Name -> Property e a -> LuaE e ())
-> Map Name (Property e a) -> LuaE e (Map Name ())
forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
Map.traverseWithKey (UDTypeWithList e fn a itemtype -> Map Name (Property e a)
forall e fn a itemtype.
UDTypeWithList e fn a itemtype -> Map Name (Property e a)
udProperties UDTypeWithList e fn a itemtype
ty) ((Name -> Property e a -> LuaE e ()) -> LuaE e (Map Name ()))
-> (Name -> Property e a -> LuaE e ()) -> LuaE e (Map Name ())
forall a b. (a -> b) -> a -> b
$ \Name
name 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)

-- | Pushes the metatable's @methods@ field table.
pushMethods :: LuaError e => UDTypeWithList e fn a itemtype -> LuaE e ()
pushMethods :: UDTypeWithList e fn a itemtype -> LuaE e ()
pushMethods UDTypeWithList e fn a itemtype
ty = do
  LuaE e ()
forall e. LuaE e ()
newtable
  LuaE e (Map Name ()) -> LuaE e ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (LuaE e (Map Name ()) -> LuaE e ())
-> LuaE e (Map Name ()) -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ ((Name -> fn -> LuaE e ()) -> Map Name fn -> LuaE e (Map Name ()))
-> Map Name fn -> (Name -> fn -> LuaE e ()) -> LuaE e (Map Name ())
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Name -> fn -> LuaE e ()) -> Map Name fn -> LuaE e (Map Name ())
forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
Map.traverseWithKey (UDTypeWithList e fn a itemtype -> Map Name fn
forall e fn a itemtype.
UDTypeWithList e fn a itemtype -> Map Name fn
udMethods UDTypeWithList e fn a itemtype
ty) ((Name -> fn -> LuaE e ()) -> LuaE e (Map Name ()))
-> (Name -> fn -> LuaE e ()) -> LuaE e (Map Name ())
forall a b. (a -> b) -> a -> b
$ \Name
name fn
fn -> do
    Name -> LuaE e ()
forall e. Name -> LuaE e ()
pushName Name
name
    UDTypeWithList e fn a itemtype -> fn -> LuaE e ()
forall e fn a itemtype.
UDTypeWithList e fn a itemtype -> fn -> LuaE e ()
udFnPusher UDTypeWithList e fn a itemtype
ty fn
fn
    StackIndex -> LuaE e ()
forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth CInt
3)

pushAliases :: LuaError e => UDTypeWithList e fn a itemtype -> LuaE e ()
pushAliases :: UDTypeWithList e fn a itemtype -> LuaE e ()
pushAliases UDTypeWithList e fn a itemtype
ty = do
  LuaE e ()
forall e. LuaE e ()
newtable
  LuaE e (Map AliasIndex ()) -> LuaE e ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (LuaE e (Map AliasIndex ()) -> LuaE e ())
-> LuaE e (Map AliasIndex ()) -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ ((AliasIndex -> Alias -> LuaE e ())
 -> Map AliasIndex Alias -> LuaE e (Map AliasIndex ()))
-> Map AliasIndex Alias
-> (AliasIndex -> Alias -> LuaE e ())
-> LuaE e (Map AliasIndex ())
forall a b c. (a -> b -> c) -> b -> a -> c
flip (AliasIndex -> Alias -> LuaE e ())
-> Map AliasIndex Alias -> LuaE e (Map AliasIndex ())
forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
Map.traverseWithKey (UDTypeWithList e fn a itemtype -> Map AliasIndex Alias
forall e fn a itemtype.
UDTypeWithList e fn a itemtype -> Map AliasIndex Alias
udAliases UDTypeWithList e fn a itemtype
ty) ((AliasIndex -> Alias -> LuaE e ()) -> LuaE e (Map AliasIndex ()))
-> (AliasIndex -> Alias -> LuaE e ()) -> LuaE e (Map AliasIndex ())
forall a b. (a -> b) -> a -> b
$ \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 :: 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

-- | Pushes the function used to iterate over the object's key-value
-- pairs in a generic *for* loop.
pairsFunction :: forall e fn a itemtype. LuaError e
              => UDTypeWithList e fn a itemtype -> LuaE e NumResults
pairsFunction :: UDTypeWithList e fn a itemtype -> LuaE e NumResults
pairsFunction UDTypeWithList e fn a itemtype
ty = do
  a
obj <- Peek e a -> LuaE e a
forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek (Peek e a -> LuaE e a) -> Peek e a -> LuaE e a
forall a b. (a -> b) -> a -> b
$ UDTypeWithList e fn a itemtype -> Peeker e a
forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> Peeker e a
peekUD UDTypeWithList e fn a itemtype
ty (CInt -> StackIndex
nthBottom CInt
1)
  let pushMember :: Member e fn a -> LuaE e NumResults
pushMember = \case
        MemberProperty Name
name Property e a
prop -> do
          Name -> LuaE e ()
forall e. Name -> LuaE e ()
pushName Name
name
          NumResults
getresults <- Property e a -> a -> LuaE e NumResults
forall e a. Property e a -> a -> LuaE e NumResults
propertyGet Property e a
prop a
obj
          if NumResults
getresults NumResults -> NumResults -> Bool
forall a. Eq a => a -> a -> Bool
== NumResults
0
            then NumResults
0 NumResults -> LuaE e () -> LuaE e NumResults
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop Int
1  -- property is absent, don't push anything
            else NumResults -> LuaE e NumResults
forall (m :: * -> *) a. Monad m => a -> m a
return (NumResults -> LuaE e NumResults)
-> NumResults -> LuaE e NumResults
forall a b. (a -> b) -> a -> b
$ NumResults
getresults NumResults -> NumResults -> NumResults
forall a. Num a => a -> a -> a
+ NumResults
1
        MemberMethod Name
name fn
f -> do
          Name -> LuaE e ()
forall e. Name -> LuaE e ()
pushName Name
name
          UDTypeWithList e fn a itemtype -> fn -> LuaE e ()
forall e fn a itemtype.
UDTypeWithList e fn a itemtype -> fn -> LuaE e ()
udFnPusher UDTypeWithList e fn a itemtype
ty fn
f
          NumResults -> LuaE e NumResults
forall (m :: * -> *) a. Monad m => a -> m a
return NumResults
2
        MemberAlias{} -> String -> LuaE e NumResults
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"aliases are not full properties"
  (Member e fn a -> LuaE e NumResults)
-> [Member e fn a] -> LuaE e NumResults
forall a e.
LuaError e =>
(a -> LuaE e NumResults) -> [a] -> LuaE e NumResults
pushIterator Member e fn a -> LuaE e NumResults
pushMember ([Member e fn a] -> LuaE e NumResults)
-> [Member e fn a] -> LuaE e NumResults
forall a b. (a -> b) -> a -> b
$
    ((Name, Property e a) -> Member e fn a)
-> [(Name, Property e a)] -> [Member e fn a]
forall a b. (a -> b) -> [a] -> [b]
map ((Name -> Property e a -> Member e fn a)
-> (Name, Property e a) -> Member e fn a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Name -> Property e a -> Member e fn a
forall e fn a. Name -> Property e a -> Member e fn a
MemberProperty) (Map Name (Property e a) -> [(Name, Property e a)]
forall k a. Map k a -> [(k, a)]
Map.toAscList (UDTypeWithList e fn a itemtype -> Map Name (Property e a)
forall e fn a itemtype.
UDTypeWithList e fn a itemtype -> Map Name (Property e a)
udProperties UDTypeWithList e fn a itemtype
ty)) [Member e fn a] -> [Member e fn a] -> [Member e fn a]
forall a. [a] -> [a] -> [a]
++
    ((Name, fn) -> Member e fn a) -> [(Name, fn)] -> [Member e fn a]
forall a b. (a -> b) -> [a] -> [b]
map ((Name -> fn -> Member e fn a) -> (Name, fn) -> Member e fn a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Name -> fn -> Member e fn a
forall e fn a. Name -> fn -> Member e fn a
MemberMethod) (Map Name fn -> [(Name, fn)]
forall k a. Map k a -> [(k, a)]
Map.toAscList (UDTypeWithList e fn a itemtype -> Map Name fn
forall e fn a itemtype.
UDTypeWithList e fn a itemtype -> Map Name fn
udMethods UDTypeWithList e fn a itemtype
ty))

-- | Evaluate part of a lazy list. Takes the following arguments, in
-- this order:
--
-- 1. userdata wrapping the unevalled part of the lazy list
-- 2. index of the last evaluated element
-- 3. index of the requested element
-- 4. the caching table
lazylisteval :: forall itemtype e. LuaError e
             => Pusher e itemtype -> LuaE e NumResults
lazylisteval :: Pusher e itemtype -> LuaE e NumResults
lazylisteval Pusher e itemtype
pushItem = do
  Maybe [itemtype]
munevaled <- StackIndex -> Name -> LuaE e (Maybe [itemtype])
forall a e. StackIndex -> Name -> LuaE e (Maybe a)
fromuserdata @[itemtype] (CInt -> StackIndex
nthBottom CInt
1) Name
lazyListStateName
  Maybe Integer
mcurindex <- StackIndex -> LuaE e (Maybe Integer)
forall e. StackIndex -> LuaE e (Maybe Integer)
tointeger (CInt -> StackIndex
nthBottom CInt
2)
  Maybe Integer
mnewindex <- StackIndex -> LuaE e (Maybe Integer)
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 = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
max (Integer
newindex Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
curindex) Integer
0
          ([itemtype]
as, [itemtype]
rest) = Int -> [itemtype] -> ([itemtype], [itemtype])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
numElems [itemtype]
unevaled
      if [itemtype] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [itemtype]
rest
        then do
          -- no more elements in list; unset variable
          Name -> LuaE e ()
forall e. Name -> LuaE e ()
pushName Name
"__lazylistindex"
          Pusher e Bool
forall e. Pusher e Bool
pushBool Bool
False
          StackIndex -> LuaE e ()
forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nthBottom CInt
4)
        else do
          -- put back remaining unevalled list
          LuaE e Bool -> LuaE e ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (LuaE e Bool -> LuaE e ()) -> LuaE e Bool -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ StackIndex -> Name -> [itemtype] -> LuaE e Bool
forall a e. StackIndex -> Name -> a -> LuaE e Bool
putuserdata @[itemtype] (CInt -> StackIndex
nthBottom CInt
1) Name
lazyListStateName [itemtype]
rest
          Name -> LuaE e ()
forall e. Name -> LuaE e ()
pushName Name
"__lazylistindex"
          Integer -> LuaE e ()
forall e. Integer -> LuaE e ()
pushinteger (Integer
curindex Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([itemtype] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [itemtype]
as))
          StackIndex -> LuaE e ()
forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nthBottom CInt
4)
      -- push evaluated elements
      [(Integer, itemtype)]
-> ((Integer, itemtype) -> LuaE e ()) -> LuaE e ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Integer] -> [itemtype] -> [(Integer, itemtype)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Integer
curindex Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1)..] [itemtype]
as) (((Integer, itemtype) -> LuaE e ()) -> LuaE e ())
-> ((Integer, itemtype) -> LuaE e ()) -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ \(Integer
i, itemtype
a) -> do
        Pusher e itemtype
pushItem itemtype
a
        StackIndex -> Integer -> LuaE e ()
forall e. LuaError e => StackIndex -> Integer -> LuaE e ()
rawseti (CInt -> StackIndex
nthBottom CInt
4) Integer
i
      NumResults -> LuaE e NumResults
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> NumResults
NumResults CInt
0)
    (Maybe [itemtype], Maybe Integer, Maybe Integer)
_ -> NumResults -> LuaE e NumResults
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CInt -> NumResults
NumResults CInt
0)

-- | Name of the metatable used for unevaluated lazy list rema
lazyListStateName :: Name
lazyListStateName :: Name
lazyListStateName = Name
"HsLua unevalled lazy list"

-- | Pushes a userdata value of the given type.
pushUD :: LuaError e => UDTypeWithList e fn a itemtype -> a -> LuaE e ()
pushUD :: UDTypeWithList e fn a itemtype -> a -> LuaE e ()
pushUD UDTypeWithList e fn a itemtype
ty a
x = do
  a -> LuaE e ()
forall a e. a -> LuaE e ()
newhsuserdata a
x
  UDTypeWithList e fn a itemtype -> LuaE e ()
forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> LuaE e ()
pushUDMetatable UDTypeWithList e fn a itemtype
ty
  StackIndex -> LuaE e ()
forall e. StackIndex -> LuaE e ()
setmetatable (CInt -> StackIndex
nth CInt
2)
  -- add list as value in caching table
  case UDTypeWithList e fn a itemtype -> Maybe (ListSpec e a itemtype)
forall e fn a itemtype.
UDTypeWithList e fn a itemtype -> Maybe (ListSpec e a itemtype)
udListSpec UDTypeWithList e fn a itemtype
ty of
    Maybe (ListSpec e a itemtype)
Nothing -> () -> LuaE e ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Just ((Pusher e itemtype
_, a -> [itemtype]
toList), (Peeker e itemtype, a -> [itemtype] -> a)
_) -> do
      LuaE e ()
forall e. LuaE e ()
newtable
      Name -> LuaE e ()
forall e. Name -> LuaE e ()
pushName Name
"__lazylist"
      [itemtype] -> LuaE e ()
forall a e. a -> LuaE e ()
newhsuserdata (a -> [itemtype]
toList a
x)
      LuaE e Bool -> LuaE e ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Name -> LuaE e Bool
forall e. Name -> LuaE e Bool
newudmetatable Name
lazyListStateName)
      StackIndex -> LuaE e ()
forall e. StackIndex -> LuaE e ()
setmetatable (CInt -> StackIndex
nth CInt
2)
      StackIndex -> LuaE e ()
forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth CInt
3)
      StackIndex -> LuaE e ()
forall e. StackIndex -> LuaE e ()
setuservalue (CInt -> StackIndex
nth CInt
2)

-- | Retrieves a userdata value of the given type.
peekUD :: LuaError e => UDTypeWithList e fn a itemtype -> Peeker e a
peekUD :: UDTypeWithList e fn a itemtype -> Peeker e a
peekUD UDTypeWithList e fn a itemtype
ty StackIndex
idx = do
  let name :: Name
name = UDTypeWithList e fn a itemtype -> Name
forall e fn a itemtype. UDTypeWithList e fn a itemtype -> Name
udName UDTypeWithList e fn a itemtype
ty
  a
x <- Name -> (StackIndex -> LuaE e (Maybe a)) -> Peeker e a
forall e a. Name -> (StackIndex -> LuaE e (Maybe a)) -> Peeker e a
reportValueOnFailure Name
name (StackIndex -> Name -> LuaE e (Maybe a)
forall a e. StackIndex -> Name -> LuaE e (Maybe a)
`fromuserdata` Name
name) StackIndex
idx
  (Peek e a -> LuaE e () -> Peek e a
forall e a b. Peek e a -> LuaE e b -> Peek e a
`lastly` Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop Int
1) (Peek e a -> Peek e a) -> Peek e a -> Peek e a
forall a b. (a -> b) -> a -> b
$ LuaE e Type -> Peek e Type
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> LuaE e Type
forall e. StackIndex -> LuaE e Type
getuservalue StackIndex
idx) Peek e Type -> (Type -> Peek e a) -> Peek e a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Type
TypeTable -> do
      -- set list
      a
xWithList <- (a -> Peek e a)
-> (ListSpec e a itemtype -> a -> Peek e a)
-> Maybe (ListSpec e a itemtype)
-> a
-> Peek e a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe a -> Peek e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ListSpec e a itemtype -> a -> Peek e a
forall itemtype e a.
LuaError e =>
ListSpec e a itemtype -> a -> Peek e a
setList (UDTypeWithList e fn a itemtype -> Maybe (ListSpec e a itemtype)
forall e fn a itemtype.
UDTypeWithList e fn a itemtype -> Maybe (ListSpec e a itemtype)
udListSpec UDTypeWithList e fn a itemtype
ty) a
x
      LuaE e a -> Peek e a
forall e a. LuaE e a -> Peek e a
liftLua (LuaE e a -> Peek e a) -> LuaE e a -> Peek e a
forall a b. (a -> b) -> a -> b
$ do
        LuaE e ()
forall e. LuaE e ()
pushnil
        Map Name (Property e a) -> a -> LuaE e a
forall e a. LuaError e => Map Name (Property e a) -> a -> LuaE e a
setProperties (UDTypeWithList e fn a itemtype -> Map Name (Property e a)
forall e fn a itemtype.
UDTypeWithList e fn a itemtype -> Map Name (Property e a)
udProperties UDTypeWithList e fn a itemtype
ty) a
xWithList
    Type
_ -> a -> Peek e a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x

-- | Retrieves object properties from a uservalue table and sets them on
-- the given value. Expects the uservalue table at the top of the stack.
setProperties :: LuaError e => Map Name (Property e a) -> a -> LuaE e a
setProperties :: Map Name (Property e a) -> a -> LuaE e a
setProperties Map Name (Property e a)
props a
x = do
  Bool
hasNext <- StackIndex -> LuaE e Bool
forall e. StackIndex -> LuaE e Bool
Unsafe.next (CInt -> StackIndex
nth CInt
2)
  if Bool -> Bool
not Bool
hasNext
    then a -> LuaE e a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
    else StackIndex -> LuaE e Type
forall e. StackIndex -> LuaE e Type
ltype (CInt -> StackIndex
nth CInt
2) LuaE e Type -> (Type -> LuaE e a) -> LuaE e a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Type
TypeString -> do
        Name
propName <- Peek e Name -> LuaE e Name
forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek (Peek e Name -> LuaE e Name) -> Peek e Name -> LuaE e Name
forall a b. (a -> b) -> a -> b
$ Peeker e Name
forall e. Peeker e Name
peekName (CInt -> StackIndex
nth CInt
2)
        case Name -> Map Name (Property e a) -> Maybe (Property e a)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
propName Map Name (Property e a)
props Maybe (Property e a)
-> (Property e a -> Maybe (StackIndex -> a -> LuaE e a))
-> Maybe (StackIndex -> a -> LuaE e a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Property e a -> Maybe (StackIndex -> a -> LuaE e a)
forall e a. Property e a -> Maybe (StackIndex -> a -> LuaE e a)
propertySet of
          Maybe (StackIndex -> a -> LuaE e a)
Nothing -> Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop Int
1 LuaE e () -> LuaE e a -> LuaE e a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Map Name (Property e a) -> a -> LuaE e a
forall e a. LuaError e => Map Name (Property e a) -> a -> LuaE e a
setProperties Map Name (Property e a)
props a
x
          Just StackIndex -> a -> LuaE e a
setter -> do
            a
x' <- StackIndex -> a -> LuaE e a
setter StackIndex
top a
x
            Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop Int
1
            Map Name (Property e a) -> a -> LuaE e a
forall e a. LuaError e => Map Name (Property e a) -> a -> LuaE e a
setProperties Map Name (Property e a)
props a
x'
      Type
_ -> a
x a -> LuaE e () -> LuaE e a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop Int
1

-- | Gets a list from a uservalue table and sets it on the given value.
-- Expects the uservalue (i.e., caching) table to be at the top of the
-- stack.
setList :: forall itemtype e a. LuaError e
        => ListSpec e a itemtype -> a
        -> Peek e a
setList :: ListSpec e a itemtype -> a -> Peek e a
setList ((Pusher e itemtype, a -> [itemtype])
_pushspec, (Peeker e itemtype
peekItem, a -> [itemtype] -> a
updateList)) a
x = (a
x a -> [itemtype] -> a
`updateList`) ([itemtype] -> a) -> Peek e [itemtype] -> Peek e a
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> do
  LuaE e Type -> Peek e Type
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> Name -> LuaE e Type
forall e. LuaError e => StackIndex -> Name -> LuaE e Type
getfield StackIndex
top Name
"__lazylistindex") Peek e Type -> (Type -> Peek e [itemtype]) -> Peek e [itemtype]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Type
TypeBoolean -> do
      -- list had been fully evaluated
      LuaE e () -> Peek e ()
forall e a. LuaE e a -> Peek e a
liftLua (LuaE e () -> Peek e ()) -> LuaE e () -> Peek e ()
forall a b. (a -> b) -> a -> b
$ Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop Int
1
      Peeker e itemtype -> Peeker e [itemtype]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e itemtype
peekItem StackIndex
top
    Type
_ -> do
      let getLazyList :: Peek e [itemtype]
getLazyList = do
            LuaE e Type -> Peek e Type
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> Name -> LuaE e Type
forall e. LuaError e => StackIndex -> Name -> LuaE e Type
getfield StackIndex
top Name
"__lazylist") Peek e Type -> (Type -> Peek e ()) -> Peek e ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
              Type
TypeUserdata -> () -> Peek e ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
              Type
_ -> ByteString -> Peek e ()
forall a e. ByteString -> Peek e a
failPeek ByteString
"unevaled items of lazy list cannot be peeked"
            (Peek e [itemtype] -> LuaE e () -> Peek e [itemtype]
forall e a b. Peek e a -> LuaE e b -> Peek e a
`lastly` Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop Int
1) (Peek e [itemtype] -> Peek e [itemtype])
-> Peek e [itemtype] -> Peek e [itemtype]
forall a b. (a -> b) -> a -> b
$ Name
-> (StackIndex -> LuaE e (Maybe [itemtype])) -> Peeker e [itemtype]
forall e a. Name -> (StackIndex -> LuaE e (Maybe a)) -> Peeker e a
reportValueOnFailure
              Name
lazyListStateName
              (\StackIndex
idx -> StackIndex -> Name -> LuaE e (Maybe [itemtype])
forall a e. StackIndex -> Name -> LuaE e (Maybe a)
fromuserdata @[itemtype] StackIndex
idx Name
lazyListStateName)
              StackIndex
top
      Maybe Integer
mlastIndex <- LuaE e (Maybe Integer) -> Peek e (Maybe Integer)
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> LuaE e (Maybe Integer)
forall e. StackIndex -> LuaE e (Maybe Integer)
tointeger StackIndex
top LuaE e (Maybe Integer) -> LuaE e () -> LuaE e (Maybe Integer)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop Int
1)
      let itemsAfter :: Integer -> Peek e [itemtype]
itemsAfter = case Maybe Integer
mlastIndex of
            Maybe Integer
Nothing -> Peek e [itemtype] -> Integer -> Peek e [itemtype]
forall a b. a -> b -> a
const Peek e [itemtype]
getLazyList
            Just Integer
lastIndex -> \Integer
i ->
              if Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
lastIndex
              then LuaE e Type -> Peek e Type
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> Integer -> LuaE e Type
forall e. LuaError e => StackIndex -> Integer -> LuaE e Type
rawgeti StackIndex
top Integer
i) Peek e Type -> (Type -> Peek e [itemtype]) -> Peek e [itemtype]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Type
TypeNil -> [] [itemtype] -> Peek e () -> Peek e [itemtype]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ LuaE e () -> Peek e ()
forall e a. LuaE e a -> Peek e a
liftLua (Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop Int
1)
                Type
_ -> do
                  itemtype
y <- Peeker e itemtype
peekItem StackIndex
top Peek e itemtype -> LuaE e () -> Peek e itemtype
forall e a b. Peek e a -> LuaE e b -> Peek e a
`lastly` Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop Int
1
                  (itemtype
yitemtype -> [itemtype] -> [itemtype]
forall a. a -> [a] -> [a]
:) ([itemtype] -> [itemtype])
-> Peek e [itemtype] -> Peek e [itemtype]
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Integer -> Peek e [itemtype]
itemsAfter (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1)
              else Peek e [itemtype]
getLazyList
      Integer -> Peek e [itemtype]
itemsAfter Integer
1