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

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 (..)
    -- * Defining types
  , deftypeGeneric
  , deftypeGeneric'
    -- ** Methods
  , methodGeneric
    -- ** Properties
  , property
  , property'
  , possibleProperty
  , possibleProperty'
  , readonly
  , readonly'
    -- ** Aliases
  , alias
    -- * Marshaling
  , peekUDGeneric
  , pushUDGeneric
  , initTypeGeneric
    -- * Type docs
  , udDocs
  , udTypeSpec
    -- * Helper types for building
  , 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

-- | 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
  { 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 ()
  }

-- | 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 :: 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

-- | 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' :: 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

-- | A read- and writable property on a UD object.
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
  }

-- | 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
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

-- | 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 :: forall fn e a. Name -> fn -> Member e fn a
methodGeneric = 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 typed property.
property' :: LuaError e
          => Name                       -- ^ property name
          -> TypeSpec                   -- ^ property type
          -> 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' :: 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))

-- | 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 :: 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))

-- | 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 :: 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

-- | Declares a new read- and writable property which is not always
-- available.
possibleProperty' :: LuaError e
  => Name                               -- ^ property name
  -> TypeSpec                           -- ^ type of the property value
  -> 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' :: 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
  }

-- | Creates a read-only object property. Attempts to set the value will
-- cause an error.
readonly' :: Name                 -- ^ property name
          -> TypeSpec             -- ^ property type
          -> Text                 -- ^ property description
          -> (Pusher e b, a -> b) -- ^ how to get the property value
          -> 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
  }

-- | 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 :: 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

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

-- | Ensures that the type has been fully initialized, i.e., that all
-- metatables have been created and stored in the registry. Returns the
-- name of the initialized type.
--
-- The @hook@ can be used to perform additional setup operations. The
-- function is called as the last step after the type metatable has been
-- initialized: the fully initialized metatable will be at the top of
-- the stack at that point. Note that the hook will /not/ be called if
-- the type's metatable already existed before this function was
-- invoked.
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)

-- | 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.
--
--
-- A @hook@ can be used to perform additional setup operations. The
-- function is called as the last step after the type metatable has been
-- initialized: the fully initialized metatable will be at the top of
-- the stack at that point. Note that the hook will /not/ be called if
-- the type's metatable already existed before this function was
-- invoked.
pushUDMetatable :: LuaError e
  => (UDTypeWithList e fn a itemtype -> LuaE e ())  -- ^ @hook@
  -> 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)

-- | 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 :: 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)

-- | Pushes the metatable's @setters@ field table.
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)

-- | Pushes the metatable's @methods@ field table.
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

-- | 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 :: 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  -- property is absent, don't push anything
            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))

-- | 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 :: 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
          -- no more elements in list; unset variable
          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
          -- put back remaining unevalled list
          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)
      -- push evaluated elements
      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)

-- | 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.
pushUDGeneric :: LuaError e
  => (UDTypeWithList e fn a itemtype -> LuaE e ()) -- ^ push docs
  -> UDTypeWithList e fn a itemtype                -- ^ userdata type
  -> a                                             -- ^ value to push
  -> 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)
  -- add list as value in caching table
  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)

-- | Retrieves a userdata value of the given type.
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
      -- set list
      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

-- | 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 :: 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

-- | 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 :: 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
      -- list had been fully evaluated
      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

--
-- Typing
--

-- | Returns documentation for this type.
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)
  }

-- | Type specifier for a UDType
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