    {-# LANGUAGE ForeignFunctionInterface #-}
    {-# LANGUAGE OverloadedStrings        #-}
    {-# LANGUAGE ScopedTypeVariables      #-}
    {-|
    Module      : HsLua.ObjectOrientation.Generic
    Copyright   : © 2021-2026 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.Generic
      ( UDTypeGeneric (..)
        -- * Defining types
      , deftypeGeneric'
        -- ** Methods
      , methodGeneric
        -- ** Properties
      , property
      , property'
      , possibleProperty
      , possibleProperty'
      , readonly
      , readonly'
        -- ** Aliases
      , alias
        -- ** Type extension
      , UDTypeHooks (..)
      , emptyHooks
        -- * Marshaling
      , peekUDGeneric
      , pushUDGeneric
      , initType
        -- * Type docs
      , udTypeSpec
        -- * Helper types for building
      , Member
      , Property (..)
      , Operation (..)
      , Possible (..)
      , Alias
      , AliasIndex (..)
      ) where

    import Control.Monad (forM_, void, when)
    import Data.Maybe (mapMaybe)
    import Data.Map (Map)
    import Data.String (IsString (..))
    import Data.Text (Text)
    import Foreign.Ptr (FunPtr)
    import HsLua.Core as Lua
    import HsLua.Marshalling
    import HsLua.ObjectOrientation.Operation
    import HsLua.Typing ( TypeSpec (..), anyType )
    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 UDTypeGeneric e fn a = UDType
      { forall e fn a. UDTypeGeneric e fn a -> Name
    udName          :: Name
      , forall e fn a. UDTypeGeneric e fn a -> [(Operation, fn)]
    udOperations    :: [(Operation, fn)]
      , forall e fn a. UDTypeGeneric e fn a -> Map Name (Property e a)
    udProperties    :: Map Name (Property e a)
      , forall e fn a. UDTypeGeneric e fn a -> Map Name fn
    udMethods       :: Map Name fn
      , forall e fn a. UDTypeGeneric e fn a -> Map AliasIndex Alias
    udAliases       :: Map AliasIndex Alias
      , forall e fn a. UDTypeGeneric e fn a -> UDTypeHooks e fn a
    udHooks         :: UDTypeHooks e fn a
      , forall e fn a. UDTypeGeneric e fn a -> fn -> LuaE e ()
    udFnPusher      :: fn -> LuaE e ()
      }

    -- | Extensions for userdata types.
    data UDTypeHooks e fn a =
      UDTypeHooks
      { forall e fn a. UDTypeHooks e fn a -> Int
    hookUservalues :: Int
        -- ^ Number of uservalues required for this extension, *including* the
        -- uservalue for the default caching table.

      , forall e fn a. UDTypeHooks e fn a -> LuaE e ()
    hookMetatableSetup :: LuaE e ()
        -- ^ Run after the metatable has been set up; the new metatable is
        -- at the top of the stack when this hook is run.

      , forall e fn a. UDTypeHooks e fn a -> a -> StackIndex -> Peek e a
    hookPeekUD :: a
                   -> StackIndex
                   -> Peek e a
        -- ^ Peek extra data and modify the peeked object

      , forall e fn a. UDTypeHooks e fn a -> a -> LuaE e ()
    hookPushUD :: a -> LuaE e ()
        -- ^ Push extra data
      }

    -- | No extension.
    emptyHooks :: UDTypeHooks e fn a
    emptyHooks :: forall e fn a. UDTypeHooks e fn a
    emptyHooks = UDTypeHooks
      { hookMetatableSetup :: LuaE e ()
    hookMetatableSetup = () -> LuaE e ()
    forall a. a -> LuaE e a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

      , hookPeekUD :: a -> StackIndex -> Peek e a
    hookPeekUD = \a
    x StackIndex
    _idx -> a -> Peek e a
    forall a. a -> Peek e a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    x

      , hookPushUD :: a -> LuaE e ()
    hookPushUD = \a
    _x -> () -> LuaE e ()
    forall a. a -> LuaE e a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

      , hookUservalues :: Int
    hookUservalues = Int
    1
      }

    -- | Defines a new "Lua type" and sets the behavior of the Lua object
    -- instances. It's possible to pass custom type extensions, which modify
    -- the default object behavior. Furthermore, the /function pusher/
    -- parameter controls how functions are marshaled to 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
                    -> UDTypeHooks e fn a   -- ^ behavior modifying hooks
                    -> UDTypeGeneric e fn a
    deftypeGeneric' :: forall e fn a.
    Pusher e fn
    -> Name
    -> [(Operation, fn)]
    -> [Member e fn a]
    -> UDTypeHooks e fn a
    -> UDTypeGeneric e fn a
    deftypeGeneric' Pusher e fn
    pushFunction Name
    name [(Operation, fn)]
    ops [Member e fn a]
    members UDTypeHooks e fn a
    extension = UDType
      { udName :: Name
    udName          = Name
    name
      , udOperations :: [(Operation, fn)]
    udOperations    = [(Operation, fn)]
    ops
      , udProperties :: Map Name (Property e a)
    udProperties    = [(Name, Property e a)] -> Map Name (Property e a)
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList ([(Name, Property e a)] -> Map Name (Property e a))
    -> [(Name, Property e a)] -> Map Name (Property e a)
    forall a b. (a -> b) -> a -> b
    $ (Member e fn a -> Maybe (Name, Property e a))
    -> [Member e fn a] -> [(Name, Property e a)]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe Member e fn a -> Maybe (Name, Property e a)
    forall {e} {fn} {a}. Member e fn a -> Maybe (Name, Property e a)
    mbproperties [Member e fn a]
    members
      , udMethods :: Map Name fn
    udMethods       = [(Name, fn)] -> Map Name fn
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList ([(Name, fn)] -> Map Name fn) -> [(Name, fn)] -> Map Name fn
    forall a b. (a -> b) -> a -> b
    $ (Member e fn a -> Maybe (Name, fn))
    -> [Member e fn a] -> [(Name, fn)]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe Member e fn a -> Maybe (Name, fn)
    forall {e} {b} {a}. Member e b a -> Maybe (Name, b)
    mbmethods [Member e fn a]
    members
      , udAliases :: Map AliasIndex Alias
    udAliases       = [(AliasIndex, Alias)] -> Map AliasIndex Alias
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList ([(AliasIndex, Alias)] -> Map AliasIndex Alias)
    -> [(AliasIndex, Alias)] -> Map AliasIndex Alias
    forall a b. (a -> b) -> a -> b
    $ (Member e fn a -> Maybe (AliasIndex, Alias))
    -> [Member e fn a] -> [(AliasIndex, Alias)]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe Member e fn a -> Maybe (AliasIndex, Alias)
    forall {e} {fn} {a}. Member e fn a -> Maybe (AliasIndex, Alias)
    mbaliases [Member e fn a]
    members
      , udHooks :: UDTypeHooks e fn a
    udHooks         = UDTypeHooks e fn a
    extension
      , udFnPusher :: Pusher e fn
    udFnPusher      = Pusher e fn
    pushFunction
      }
      where
        mbproperties :: Member e fn a -> Maybe (Name, Property e a)
    mbproperties = \case
          MemberProperty Name
    n Property e a
    p -> (Name, Property e a) -> Maybe (Name, Property e a)
    forall a. a -> Maybe a
    Just (Name
    n, Property e a
    p)
          Member e fn a
    _ -> Maybe (Name, Property e a)
    forall a. Maybe a
    Nothing
        mbmethods :: Member e b a -> Maybe (Name, b)
    mbmethods = \case
          MemberMethod Name
    n b
    m -> (Name, b) -> Maybe (Name, b)
    forall a. a -> Maybe a
    Just (Name
    n, b
    m)
          Member e b a
    _ -> Maybe (Name, b)
    forall a. Maybe a
    Nothing
        mbaliases :: Member e fn a -> Maybe (AliasIndex, Alias)
    mbaliases = \case
          MemberAlias AliasIndex
    n Alias
    a -> (AliasIndex, Alias) -> Maybe (AliasIndex, Alias)
    forall a. a -> Maybe a
    Just (AliasIndex
    n, Alias
    a)
          Member e fn a
    _ -> Maybe (AliasIndex, Alias)
    forall a. Maybe a
    Nothing

    -- | 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
    (AliasIndex -> AliasIndex -> Bool)
    -> (AliasIndex -> AliasIndex -> Bool) -> Eq AliasIndex
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: AliasIndex -> AliasIndex -> Bool
    == :: AliasIndex -> AliasIndex -> Bool
    $c/= :: AliasIndex -> AliasIndex -> Bool
    /= :: AliasIndex -> AliasIndex -> Bool
    Eq, Eq AliasIndex
    Eq AliasIndex =>
    (AliasIndex -> AliasIndex -> Ordering)
    -> (AliasIndex -> AliasIndex -> Bool)
    -> (AliasIndex -> AliasIndex -> Bool)
    -> (AliasIndex -> AliasIndex -> Bool)
    -> (AliasIndex -> AliasIndex -> Bool)
    -> (AliasIndex -> AliasIndex -> AliasIndex)
    -> (AliasIndex -> AliasIndex -> AliasIndex)
    -> Ord AliasIndex
    AliasIndex -> AliasIndex -> Bool
    AliasIndex -> AliasIndex -> Ordering
    AliasIndex -> AliasIndex -> AliasIndex
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: AliasIndex -> AliasIndex -> Ordering
    compare :: AliasIndex -> AliasIndex -> Ordering
    $c< :: AliasIndex -> AliasIndex -> Bool
    < :: AliasIndex -> AliasIndex -> Bool
    $c<= :: AliasIndex -> AliasIndex -> Bool
    <= :: AliasIndex -> AliasIndex -> Bool
    $c> :: AliasIndex -> AliasIndex -> Bool
    > :: AliasIndex -> AliasIndex -> Bool
    $c>= :: AliasIndex -> AliasIndex -> Bool
    >= :: AliasIndex -> AliasIndex -> Bool
    $cmax :: AliasIndex -> AliasIndex -> AliasIndex
    max :: AliasIndex -> AliasIndex -> AliasIndex
    $cmin :: AliasIndex -> AliasIndex -> AliasIndex
    min :: AliasIndex -> AliasIndex -> AliasIndex
    Ord)

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

    -- | 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 = 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 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) =
      Name
    -> TypeSpec
    -> Text
    -> (Pusher e b, a -> Possible b)
    -> (Peeker e b, a -> b -> Possible a)
    -> Member e fn a
    forall e b a fn.
    LuaError e =>
    Name
    -> TypeSpec
    -> Text
    -> (Pusher e b, a -> Possible b)
    -> (Peeker e b, a -> b -> Possible a)
    -> Member e fn a
    possibleProperty' Name
    name TypeSpec
    typespec Text
    desc
        (Pusher e b
    push, b -> Possible b
    forall a. a -> Possible a
    Actual (b -> Possible b) -> (a -> b) -> a -> Possible b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> b
    get)
        (Peeker e b
    peek, \a
    a b
    b -> a -> Possible a
    forall a. a -> Possible a
    Actual (a -> b -> a
    set a
    a b
    b))

    -- | 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) =
      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 :: forall e b a fn.
    LuaError e =>
    Name
    -> Text
    -> (Pusher e b, a -> Possible b)
    -> (Peeker e b, a -> b -> Possible a)
    -> Member e fn a
    possibleProperty Name
    name = Name
    -> TypeSpec
    -> Text
    -> (Pusher e b, a -> Possible b)
    -> (Peeker e b, a -> b -> Possible a)
    -> Member e fn a
    forall e b a fn.
    LuaError e =>
    Name
    -> TypeSpec
    -> Text
    -> (Pusher e b, a -> Possible b)
    -> (Peeker e b, a -> b -> Possible a)
    -> Member e fn a
    possibleProperty' Name
    name TypeSpec
    anyType

    -- | 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) =
      Name -> Property e a -> Member e fn a
    forall e fn a. Name -> Property e a -> Member e fn a
    MemberProperty Name
    name (Property e a -> Member e fn a) -> Property e a -> Member e fn a
    forall a b. (a -> b) -> a -> b
    $
      Property
      { propertyGet :: a -> LuaE e NumResults
    propertyGet = \a
    x -> do
          case a -> Possible b
    get a
    x of
            Actual b
    y -> CInt -> NumResults
    NumResults CInt
    1 NumResults -> LuaE e () -> LuaE e NumResults
    forall a b. a -> LuaE e b -> LuaE e a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Pusher e b
    push b
    y
            Possible b
    Absent   -> NumResults -> LuaE e NumResults
    forall a. a -> LuaE e a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CInt -> NumResults
    NumResults CInt
    0)
      , propertySet :: Maybe (StackIndex -> a -> LuaE e a)
    propertySet = (StackIndex -> a -> LuaE e a)
    -> Maybe (StackIndex -> a -> LuaE e a)
    forall a. a -> Maybe a
    Just ((StackIndex -> a -> LuaE e a)
     -> Maybe (StackIndex -> a -> LuaE e a))
    -> (StackIndex -> a -> LuaE e a)
    -> Maybe (StackIndex -> a -> LuaE e a)
    forall a b. (a -> b) -> a -> b
    $ \StackIndex
    idx a
    x -> do
          value  <- Peek e b -> LuaE e b
    forall e a. LuaError e => Peek e a -> LuaE e a
    forcePeek (Peek e b -> LuaE e b) -> Peek e b -> LuaE e b
    forall a b. (a -> b) -> a -> b
    $ Peeker e b
    peek StackIndex
    idx
          case set x value of
            Actual a
    y -> a -> LuaE e a
    forall a. a -> LuaE e a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    y
            Possible a
    Absent   -> String -> LuaE e a
    forall e a. LuaError e => String -> LuaE e a
    failLua (String -> LuaE e a) -> String -> LuaE e a
    forall a b. (a -> b) -> a -> b
    $ String
    "Trying to set unavailable property "
                                String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> ByteString -> String
    Utf8.toString (Name -> ByteString
    fromName Name
    name)
                                String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    "."
      , propertyType :: TypeSpec
    propertyType = TypeSpec
    typespec
      , propertyDescription :: Text
    propertyDescription = Text
    desc
      }

    -- | 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) = Name -> Property e a -> Member e fn a
    forall e fn a. Name -> Property e a -> Member e fn a
    MemberProperty Name
    name (Property e a -> Member e fn a) -> Property e a -> Member e fn a
    forall a b. (a -> b) -> a -> b
    $
      Property
      { propertyGet :: a -> LuaE e NumResults
    propertyGet = \a
    x -> do
          Pusher e b
    push Pusher e b -> Pusher e b
    forall a b. (a -> b) -> a -> b
    $ a -> b
    get a
    x
          NumResults -> LuaE e NumResults
    forall a. a -> LuaE e a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CInt -> NumResults
    NumResults CInt
    1)
      , propertySet :: Maybe (StackIndex -> a -> LuaE e a)
    propertySet = Maybe (StackIndex -> a -> LuaE e a)
    forall a. Maybe a
    Nothing
      , propertyType :: TypeSpec
    propertyType = TypeSpec
    typespec
      , propertyDescription :: Text
    propertyDescription = Text
    desc
      }

    -- | 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 = Name -> TypeSpec -> Text -> (Pusher e b, a -> b) -> Member e fn a
    forall e b a fn.
    Name -> TypeSpec -> Text -> (Pusher e b, a -> b) -> Member e fn a
    readonly' Name
    name TypeSpec
    anyType

    -- | 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 = AliasIndex -> Alias -> Member e fn a
    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.
    initType :: LuaError e
             => UDTypeGeneric e fn a
             -> LuaE e Name
    initType :: forall e fn a. LuaError e => UDTypeGeneric e fn a -> LuaE e Name
    initType UDTypeGeneric e fn a
    ty = do
      UDTypeGeneric e fn a -> LuaE e ()
    forall e fn a. LuaError e => UDTypeGeneric e fn a -> LuaE e ()
    pushUDMetatable UDTypeGeneric e fn a
    ty
      Int -> LuaE e ()
    forall e. Int -> LuaE e ()
    pop Int
    1
      Name -> LuaE e Name
    forall a. a -> LuaE e a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (UDTypeGeneric e fn a -> Name
    forall e fn a. UDTypeGeneric e fn a -> Name
    udName UDTypeGeneric e fn a
    ty)

    -- | 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
      :: forall e fn a. LuaError e
      => UDTypeGeneric e fn a
      -> LuaE e ()
    pushUDMetatable :: forall e fn a. LuaError e => UDTypeGeneric e fn a -> LuaE e ()
    pushUDMetatable UDTypeGeneric e fn a
    ty = do
      created <- Name -> LuaE e Bool
    forall e. Name -> LuaE e Bool
    newudmetatable (UDTypeGeneric e fn a -> Name
    forall e fn a. UDTypeGeneric e fn a -> Name
    udName UDTypeGeneric e fn a
    ty)
      when created $ do
        add (metamethodName Index)    $ pushcfunction hslua_udindex_ptr
        add (metamethodName Newindex) $ pushcfunction hslua_udnewindex_ptr
        add (metamethodName Pairs)    $ pushHaskellFunction (pairsFunction ty)
        forM_ (udOperations ty) $ \(Operation
    op, fn
    f) -> do
          Name -> LuaE e () -> LuaE e ()
    add (Operation -> Name
    metamethodName Operation
    op) (LuaE e () -> LuaE e ()) -> LuaE e () -> LuaE e ()
    forall a b. (a -> b) -> a -> b
    $ UDTypeGeneric e fn a -> fn -> LuaE e ()
    forall e fn a. UDTypeGeneric e fn a -> fn -> LuaE e ()
    udFnPusher UDTypeGeneric e fn a
    ty fn
    f
        add "getters" $ pushGetters ty
        add "setters" $ pushSetters ty
        add "methods" $ pushMethods ty
        add "aliases" $ pushAliases ty
        hookMetatableSetup (udHooks ty)
      where
        add :: Name -> LuaE e () -> LuaE e ()
        add :: Name -> LuaE e () -> LuaE e ()
    add Name
    name LuaE e ()
    op = do
          Name -> LuaE e ()
    forall e. Name -> LuaE e ()
    pushName Name
    name
          LuaE e ()
    op
          StackIndex -> LuaE e ()
    forall e. LuaError e => StackIndex -> LuaE e ()
    rawset (CInt -> StackIndex
    nth CInt
    3)

    -- | 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
      => UDTypeGeneric e fn a -> LuaE e ()
    pushGetters :: forall e fn a. LuaError e => UDTypeGeneric e fn a -> LuaE e ()
    pushGetters UDTypeGeneric e fn a
    ty = do
      LuaE e ()
    forall e. LuaE e ()
    newtable
      LuaE e (Map Name ()) -> LuaE e ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (LuaE e (Map Name ()) -> LuaE e ())
    -> LuaE e (Map Name ()) -> LuaE e ()
    forall a b. (a -> b) -> a -> b
    $ ((Name -> Property e a -> LuaE e ())
     -> Map Name (Property e a) -> LuaE e (Map Name ()))
    -> Map Name (Property e a)
    -> (Name -> Property e a -> LuaE e ())
    -> LuaE e (Map Name ())
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (Name -> Property e a -> LuaE e ())
    -> Map Name (Property e a) -> LuaE e (Map Name ())
    forall (t :: * -> *) k a b.
    Applicative t =>
    (k -> a -> t b) -> Map k a -> t (Map k b)
    Map.traverseWithKey (UDTypeGeneric e fn a -> Map Name (Property e a)
    forall e fn a. UDTypeGeneric e fn a -> Map Name (Property e a)
    udProperties UDTypeGeneric e fn a
    ty) ((Name -> Property e a -> LuaE e ()) -> LuaE e (Map Name ()))
    -> (Name -> Property e a -> LuaE e ()) -> LuaE e (Map Name ())
    forall a b. (a -> b) -> a -> b
    $ \Name
    name Property e a
    prop -> do
        Name -> LuaE e ()
    forall e. Name -> LuaE e ()
    pushName Name
    name
        HaskellFunction e -> LuaE e ()
    forall e. LuaError e => HaskellFunction e -> LuaE e ()
    pushHaskellFunction (HaskellFunction e -> LuaE e ()) -> HaskellFunction e -> LuaE e ()
    forall a b. (a -> b) -> a -> b
    $ Peek e a -> LuaE e a
    forall e a. LuaError e => Peek e a -> LuaE e a
    forcePeek (UDTypeGeneric e fn a -> Peeker e a
    forall e fn a. LuaError e => UDTypeGeneric e fn a -> Peeker e a
    peekUDGeneric UDTypeGeneric e fn a
    ty StackIndex
    1) LuaE e a -> (a -> HaskellFunction e) -> HaskellFunction e
    forall a b. LuaE e a -> (a -> LuaE e b) -> LuaE e b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Property e a -> a -> HaskellFunction e
    forall e a. Property e a -> a -> LuaE e NumResults
    propertyGet Property e a
    prop
        StackIndex -> LuaE e ()
    forall e. LuaError e => StackIndex -> LuaE e ()
    rawset (CInt -> StackIndex
    nth CInt
    3)

    -- | Pushes the metatable's @setters@ field table.
    pushSetters :: LuaError e => UDTypeGeneric e fn a -> LuaE e ()
    pushSetters :: forall e fn a. LuaError e => UDTypeGeneric e fn a -> LuaE e ()
    pushSetters UDTypeGeneric e fn a
    ty = do
      LuaE e ()
    forall e. LuaE e ()
    newtable
      LuaE e (Map Name ()) -> LuaE e ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (LuaE e (Map Name ()) -> LuaE e ())
    -> LuaE e (Map Name ()) -> LuaE e ()
    forall a b. (a -> b) -> a -> b
    $ ((Name -> Property e a -> LuaE e ())
     -> Map Name (Property e a) -> LuaE e (Map Name ()))
    -> Map Name (Property e a)
    -> (Name -> Property e a -> LuaE e ())
    -> LuaE e (Map Name ())
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (Name -> Property e a -> LuaE e ())
    -> Map Name (Property e a) -> LuaE e (Map Name ())
    forall (t :: * -> *) k a b.
    Applicative t =>
    (k -> a -> t b) -> Map k a -> t (Map k b)
    Map.traverseWithKey (UDTypeGeneric e fn a -> Map Name (Property e a)
    forall e fn a. UDTypeGeneric e fn a -> Map Name (Property e a)
    udProperties UDTypeGeneric e fn a
    ty) ((Name -> Property e a -> LuaE e ()) -> LuaE e (Map Name ()))
    -> (Name -> Property e a -> LuaE e ()) -> LuaE e (Map Name ())
    forall a b. (a -> b) -> a -> b
    $ \Name
    name Property e a
    prop -> do
        Name -> LuaE e ()
    forall e. Name -> LuaE e ()
    pushName Name
    name
        CFunction -> LuaE e ()
    forall e. CFunction -> LuaE e ()
    pushcfunction (CFunction -> LuaE e ()) -> CFunction -> LuaE e ()
    forall a b. (a -> b) -> a -> b
    $ case Property e a -> Maybe (StackIndex -> a -> LuaE e a)
    forall e a. Property e a -> Maybe (StackIndex -> a -> LuaE e a)
    propertySet Property e a
    prop of
          Just StackIndex -> a -> LuaE e a
    _  -> CFunction
    hslua_udsetter_ptr
          Maybe (StackIndex -> a -> LuaE e a)
    Nothing -> CFunction
    hslua_udreadonly_ptr
        StackIndex -> LuaE e ()
    forall e. LuaError e => StackIndex -> LuaE e ()
    rawset (CInt -> StackIndex
    nth CInt
    3)

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

    pushAliases :: LuaError e => UDTypeGeneric e fn a -> LuaE e ()
    pushAliases :: forall e fn a. LuaError e => UDTypeGeneric e fn a -> LuaE e ()
    pushAliases UDTypeGeneric e fn a
    ty = do
      LuaE e ()
    forall e. LuaE e ()
    newtable
      LuaE e (Map AliasIndex ()) -> LuaE e ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (LuaE e (Map AliasIndex ()) -> LuaE e ())
    -> LuaE e (Map AliasIndex ()) -> LuaE e ()
    forall a b. (a -> b) -> a -> b
    $ ((AliasIndex -> Alias -> LuaE e ())
     -> Map AliasIndex Alias -> LuaE e (Map AliasIndex ()))
    -> Map AliasIndex Alias
    -> (AliasIndex -> Alias -> LuaE e ())
    -> LuaE e (Map AliasIndex ())
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (AliasIndex -> Alias -> LuaE e ())
    -> Map AliasIndex Alias -> LuaE e (Map AliasIndex ())
    forall (t :: * -> *) k a b.
    Applicative t =>
    (k -> a -> t b) -> Map k a -> t (Map k b)
    Map.traverseWithKey (UDTypeGeneric e fn a -> Map AliasIndex Alias
    forall e fn a. UDTypeGeneric e fn a -> Map AliasIndex Alias
    udAliases UDTypeGeneric e fn a
    ty) ((AliasIndex -> Alias -> LuaE e ()) -> LuaE e (Map AliasIndex ()))
    -> (AliasIndex -> Alias -> LuaE e ()) -> LuaE e (Map AliasIndex ())
    forall a b. (a -> b) -> a -> b
    $ \AliasIndex
    name Alias
    propSeq -> do
        Pusher e AliasIndex
    forall e. Pusher e AliasIndex
    pushAliasIndex AliasIndex
    name
        Pusher e AliasIndex -> Alias -> LuaE e ()
    forall e a. LuaError e => Pusher e a -> [a] -> LuaE e ()
    pushList Pusher e AliasIndex
    forall e. Pusher e AliasIndex
    pushAliasIndex Alias
    propSeq
        StackIndex -> LuaE e ()
    forall e. LuaError e => StackIndex -> LuaE e ()
    rawset (CInt -> StackIndex
    nth CInt
    3)

    pushAliasIndex :: Pusher e AliasIndex
    pushAliasIndex :: forall e. Pusher e AliasIndex
    pushAliasIndex = \case
      StringIndex Name
    name -> Name -> LuaE e ()
    forall e. Name -> LuaE e ()
    pushName Name
    name
      IntegerIndex Integer
    n   -> Integer -> LuaE e ()
    forall a e. (Integral a, Show a) => a -> LuaE e ()
    pushIntegral Integer
    n

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

    -- | Pushes a userdata value of the given type.
    pushUDGeneric
      :: LuaError e
      => UDTypeGeneric e fn a                -- ^ userdata type
      -> a                                   -- ^ value to push
      -> LuaE e ()
    pushUDGeneric :: forall e fn a. LuaError e => UDTypeGeneric e fn a -> a -> LuaE e ()
    pushUDGeneric UDTypeGeneric e fn a
    ty a
    x = do
      a -> Int -> LuaE e ()
    forall a e. a -> Int -> LuaE e ()
    newhsuserdatauv a
    x (UDTypeHooks e fn a -> Int
    forall e fn a. UDTypeHooks e fn a -> Int
    hookUservalues (UDTypeGeneric e fn a -> UDTypeHooks e fn a
    forall e fn a. UDTypeGeneric e fn a -> UDTypeHooks e fn a
    udHooks UDTypeGeneric e fn a
    ty))
      UDTypeGeneric e fn a -> LuaE e ()
    forall e fn a. LuaError e => UDTypeGeneric e fn a -> LuaE e ()
    pushUDMetatable UDTypeGeneric e fn a
    ty
      StackIndex -> LuaE e ()
    forall e. StackIndex -> LuaE e ()
    setmetatable (CInt -> StackIndex
    nth CInt
    2)
      UDTypeHooks e fn a -> a -> LuaE e ()
    forall e fn a. UDTypeHooks e fn a -> a -> LuaE e ()
    hookPushUD (UDTypeGeneric e fn a -> UDTypeHooks e fn a
    forall e fn a. UDTypeGeneric e fn a -> UDTypeHooks e fn a
    udHooks UDTypeGeneric e fn a
    ty) a
    x

    -- | Retrieves a userdata value of the given type.
    peekUDGeneric :: LuaError e
                  => UDTypeGeneric e fn a -> Peeker e a
    peekUDGeneric :: forall e fn a. LuaError e => UDTypeGeneric e fn a -> Peeker e a
    peekUDGeneric UDTypeGeneric e fn a
    ty StackIndex
    idx = do
      let name :: Name
    name = UDTypeGeneric e fn a -> Name
    forall e fn a. UDTypeGeneric e fn a -> Name
    udName UDTypeGeneric e fn a
    ty
      old <- Name -> (StackIndex -> LuaE e (Maybe a)) -> Peeker e a
    forall e a. Name -> (StackIndex -> LuaE e (Maybe a)) -> Peeker e a
    reportValueOnFailure Name
    name (StackIndex -> Name -> LuaE e (Maybe a)
    forall a e. StackIndex -> Name -> LuaE e (Maybe a)
    `fromuserdata` Name
    name) StackIndex
    idx
      -- get caching table and update the Haskell value
      updated <- liftLua (getiuservalue idx 1) >>= \case
        Type
    TypeTable -> LuaE e a -> Peek e a
    forall e a. LuaE e a -> Peek e a
    liftLua (LuaE e a -> Peek e a) -> LuaE e a -> Peek e a
    forall a b. (a -> b) -> a -> b
    $ do
          LuaE e ()
    forall e. LuaE e ()
    pushnil
          Map Name (Property e a) -> a -> LuaE e a
    forall e a. LuaError e => Map Name (Property e a) -> a -> LuaE e a
    setProperties (UDTypeGeneric e fn a -> Map Name (Property e a)
    forall e fn a. UDTypeGeneric e fn a -> Map Name (Property e a)
    udProperties UDTypeGeneric e fn a
    ty) a
    old
        Type
    _other -> a -> Peek e a
    forall a. a -> Peek e a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    old
      liftLua $ pop 1  -- pop caching table
      hookPeekUD (udHooks ty) updated idx

    -- | 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
      hasNext <- StackIndex -> LuaE e Bool
    forall e. StackIndex -> LuaE e Bool
    Unsafe.next (CInt -> StackIndex
    nth CInt
    2)
      let continue a
    value = Int -> LuaE e ()
    forall e. Int -> LuaE e ()
    pop Int
    1 LuaE e () -> LuaE e a -> LuaE e a
    forall a b. LuaE e a -> LuaE e b -> LuaE e b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Map Name (Property e a) -> a -> LuaE e a
    forall e a. LuaError e => Map Name (Property e a) -> a -> LuaE e a
    setProperties Map Name (Property e a)
    props a
    value
      if not hasNext
        then return x
        else ltype (nth 2) >>= \case
          Type
    TypeString -> do
            propName <- Peek e Name -> LuaE e Name
    forall e a. LuaError e => Peek e a -> LuaE e a
    forcePeek (Peek e Name -> LuaE e Name) -> Peek e Name -> LuaE e Name
    forall a b. (a -> b) -> a -> b
    $ Peeker e Name
    forall e. Peeker e Name
    peekName (CInt -> StackIndex
    nth CInt
    2)
            case Map.lookup propName props >>= propertySet of
              Maybe (StackIndex -> a -> LuaE e a)
    Nothing -> a -> LuaE e a
    continue a
    x
              Just StackIndex -> a -> LuaE e a
    setter -> do
                x' <- StackIndex -> a -> LuaE e a
    setter StackIndex
    top a
    x
                continue x'
          Type
    _ -> a -> LuaE e a
    continue a
    x

    --
    -- Typing
    --

    -- | Type specifier for a UDType
    udTypeSpec :: UDTypeGeneric e fn a
               -> TypeSpec
    udTypeSpec :: forall e fn a. UDTypeGeneric e fn a -> TypeSpec
    udTypeSpec = Name -> TypeSpec
    NamedType (Name -> TypeSpec)
    -> (UDTypeGeneric e fn a -> Name)
    -> UDTypeGeneric e fn a
    -> TypeSpec
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . UDTypeGeneric e fn a -> Name
    forall e fn a. UDTypeGeneric e fn a -> Name
    udName