{-# LANGUAGE OverloadedStrings #-}
{-|
Module      : HsLua.Packaging.UDType
Copyright   : © 2020-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.Packaging.UDType
  ( DocumentedType
  , DocumentedTypeWithList
  , deftype
  , deftype'
  , method
  , property
  , property'
  , possibleProperty
  , possibleProperty'
  , readonly
  , readonly'
  , alias
  , operation
  , peekUD
  , pushUD
  , initType  -- Reexported from ObjectOrientation
  , udparam
  , udresult
  , udTypeSpec
    -- * Helper types for building
  , Member
  , Operation (..)
  , Property
  , Possible (..)
  ) where

import Data.Map (Map)
import Data.Text (Text)
import HsLua.Core
import HsLua.Marshalling
import HsLua.ObjectOrientation
import HsLua.ObjectOrientation.Operation (metamethodName)
import HsLua.Packaging.Function
import HsLua.Packaging.Types (DocumentedType, setName)
import HsLua.Typing (pushTypeSpec)
import qualified Data.Map as Map

-- | 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 DocumentedTypeWithList e a itemtype =
  UDTypeWithList e (DocumentedFunction e) a itemtype

-- | Defines a new type, defining the behavior of objects in Lua.
-- Note that the type name must be unique.
deftype :: LuaError e
        => Name                                 -- ^ type name
        -> [(Operation, DocumentedFunction e)]  -- ^ operations
        -> [Member e (DocumentedFunction e) a]  -- ^ methods
        -> DocumentedType e a
deftype :: forall e a.
LuaError e =>
Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) a]
-> DocumentedType e a
deftype Name
name [(Operation, DocumentedFunction e)]
ops [Member e (DocumentedFunction e) a]
methods = UDTypeGeneric e (DocumentedFunction e) a
-> UDTypeGeneric e (DocumentedFunction e) a
forall e a.
LuaError e =>
UDTypeGeneric e (DocumentedFunction e) a
-> UDTypeGeneric e (DocumentedFunction e) a
addDocHooks (UDTypeGeneric e (DocumentedFunction e) a
 -> UDTypeGeneric e (DocumentedFunction e) a)
-> UDTypeGeneric e (DocumentedFunction e) a
-> UDTypeGeneric e (DocumentedFunction e) a
forall a b. (a -> b) -> a -> b
$
  Pusher e (DocumentedFunction e)
-> Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) a]
-> UDTypeHooks e (DocumentedFunction e) a
-> UDTypeGeneric e (DocumentedFunction e) a
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 (DocumentedFunction e)
forall e. LuaError e => DocumentedFunction e -> LuaE e ()
pushDocumentedFunction Name
name [(Operation, DocumentedFunction e)]
ops [Member e (DocumentedFunction e) a]
methods UDTypeHooks e (DocumentedFunction e) a
forall e fn a. UDTypeHooks e fn a
emptyHooks

-- | 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.
deftype' :: LuaError e
         => Name                                 -- ^ type name
         -> [(Operation, DocumentedFunction e)]  -- ^ operations
         -> [Member e (DocumentedFunction e) a]  -- ^ methods
         -> Maybe (ListSpec e a itemtype)  -- ^ list access
         -> DocumentedTypeWithList e a itemtype
deftype' :: forall e a itemtype.
LuaError e =>
Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) a]
-> Maybe (ListSpec e a itemtype)
-> DocumentedTypeWithList e a itemtype
deftype' Name
name [(Operation, DocumentedFunction e)]
ops [Member e (DocumentedFunction e) a]
methods Maybe (ListSpec e a itemtype)
mlistSpec = UDTypeGeneric e (DocumentedFunction e) a
-> UDTypeGeneric e (DocumentedFunction e) a
forall e a.
LuaError e =>
UDTypeGeneric e (DocumentedFunction e) a
-> UDTypeGeneric e (DocumentedFunction e) a
addDocHooks (UDTypeGeneric e (DocumentedFunction e) a
 -> UDTypeGeneric e (DocumentedFunction e) a)
-> (UDTypeHooks e (DocumentedFunction e) a
    -> UDTypeGeneric e (DocumentedFunction e) a)
-> UDTypeHooks e (DocumentedFunction e) a
-> UDTypeGeneric e (DocumentedFunction e) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Pusher e (DocumentedFunction e)
-> Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) a]
-> UDTypeHooks e (DocumentedFunction e) a
-> UDTypeGeneric e (DocumentedFunction e) a
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 (DocumentedFunction e)
forall e. LuaError e => DocumentedFunction e -> LuaE e ()
pushDocumentedFunction Name
name [(Operation, DocumentedFunction e)]
ops [Member e (DocumentedFunction e) a]
methods (UDTypeHooks e (DocumentedFunction e) a
 -> UDTypeGeneric e (DocumentedFunction e) a)
-> UDTypeHooks e (DocumentedFunction e) a
-> UDTypeGeneric e (DocumentedFunction e) a
forall a b. (a -> b) -> a -> b
$
    UDTypeHooks e (DocumentedFunction e) a
-> (ListSpec e a itemtype
    -> UDTypeHooks e (DocumentedFunction e) a)
-> Maybe (ListSpec e a itemtype)
-> UDTypeHooks e (DocumentedFunction e) a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe UDTypeHooks e (DocumentedFunction e) a
forall e fn a. UDTypeHooks e fn a
emptyHooks ListSpec e a itemtype -> UDTypeHooks e (DocumentedFunction e) a
forall e a itemtype fn.
LuaError e =>
ListSpec e a itemtype -> UDTypeHooks e fn a
listExtension Maybe (ListSpec e a itemtype)
mlistSpec

-- | Use a documented function as an object method.
method :: DocumentedFunction e
       -> Member e (DocumentedFunction e) a
method :: forall e a.
DocumentedFunction e -> Member e (DocumentedFunction e) a
method DocumentedFunction e
f = Name -> DocumentedFunction e -> Member e (DocumentedFunction e) a
forall fn e a. Name -> fn -> Member e fn a
methodGeneric (DocumentedFunction e -> Name
forall e. DocumentedFunction e -> Name
functionName DocumentedFunction e
f) DocumentedFunction e
f

-- | Declares a new object operation from a documented function.
operation :: Operation             -- ^ the kind of operation
          -> DocumentedFunction e  -- ^ function used to perform the operation
          -> (Operation, DocumentedFunction e)
operation :: forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
op DocumentedFunction e
f = (,) Operation
op (DocumentedFunction e -> (Operation, DocumentedFunction e))
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall a b. (a -> b) -> a -> b
$ DocumentedFunction e
f DocumentedFunction e -> Name -> DocumentedFunction e
forall a. HasName a => a -> Name -> a
`setName` Operation -> Name
metamethodName Operation
op

-- | Defines a function parameter that takes the given type.
udparam :: LuaError e
        => DocumentedTypeWithList e a itemtype  -- ^ expected type
        -> Text            -- ^ parameter name
        -> Text            -- ^ parameter description
        -> Parameter e a
udparam :: forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype
-> Text -> Text -> Parameter e a
udparam DocumentedTypeWithList e a itemtype
ty = Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter (DocumentedTypeWithList e a itemtype -> Peeker e a
forall e fn a. LuaError e => UDTypeGeneric e fn a -> Peeker e a
peekUDGeneric DocumentedTypeWithList e a itemtype
ty) (DocumentedTypeWithList e a itemtype -> TypeSpec
forall e fn a. UDTypeGeneric e fn a -> TypeSpec
udTypeSpec DocumentedTypeWithList e a itemtype
ty)

-- | Defines a function result of the given type.
udresult :: LuaError e
         => DocumentedTypeWithList e a itemtype -- ^ result type
         -> Text           -- ^ result description
         -> FunctionResults e a
udresult :: forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype -> Text -> FunctionResults e a
udresult DocumentedTypeWithList e a itemtype
ty = Pusher e a -> TypeSpec -> Text -> FunctionResults e a
forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult (DocumentedTypeWithList e a itemtype -> Pusher e a
forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype -> a -> LuaE e ()
pushUD DocumentedTypeWithList e a itemtype
ty) (DocumentedTypeWithList e a itemtype -> TypeSpec
forall e fn a. UDTypeGeneric e fn a -> TypeSpec
udTypeSpec DocumentedTypeWithList e a itemtype
ty)

-- | Pushes a userdata value of the given type.
pushUD :: LuaError e => DocumentedTypeWithList e a itemtype -> a -> LuaE e ()
pushUD :: forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype -> a -> LuaE e ()
pushUD = UDTypeGeneric e (DocumentedFunction e) a -> a -> LuaE e ()
forall e fn a. LuaError e => UDTypeGeneric e fn a -> a -> LuaE e ()
pushUDGeneric

-- | Retrieves a userdata value of the given type.
peekUD :: LuaError e => DocumentedTypeWithList e a itemtype -> Peeker e a
peekUD :: forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype -> Peeker e a
peekUD = UDTypeGeneric e (DocumentedFunction e) a -> Peeker e a
forall e fn a. LuaError e => UDTypeGeneric e fn a -> Peeker e a
peekUDGeneric

-- | Adds a hook to the type that pushes the documentation.
addDocHooks
  :: LuaError e
  => UDTypeGeneric e (DocumentedFunction e) a
  -> UDTypeGeneric e (DocumentedFunction e) a
addDocHooks :: forall e a.
LuaError e =>
UDTypeGeneric e (DocumentedFunction e) a
-> UDTypeGeneric e (DocumentedFunction e) a
addDocHooks UDTypeGeneric e (DocumentedFunction e) a
ty =
  let hooks :: UDTypeHooks e (DocumentedFunction e) a
hooks = UDTypeGeneric e (DocumentedFunction e) a
-> UDTypeHooks e (DocumentedFunction e) a
forall e fn a. UDTypeGeneric e fn a -> UDTypeHooks e fn a
udHooks UDTypeGeneric e (DocumentedFunction e) a
ty
  in UDTypeGeneric e (DocumentedFunction e) a
ty
     { udHooks = hooks
       { hookMetatableSetup = do
           hookMetatableSetup hooks
           pushUDTypeDocs ty
       }
     }

-- | Pushes a documentation table for the given UD type.
pushUDTypeDocs :: LuaError e
               => DocumentedTypeWithList e a itemtype
               -> LuaE e ()
pushUDTypeDocs :: forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype -> LuaE e ()
pushUDTypeDocs DocumentedTypeWithList e a itemtype
ty = do
  -- metadata table is at the top of the stack
  Name -> LuaE e ()
forall e. Name -> LuaE e ()
pushName Name
"docs"
  [(Name, DocumentedTypeWithList e a itemtype -> LuaE e ())]
-> DocumentedTypeWithList e a itemtype -> LuaE e ()
forall e a.
LuaError e =>
[(Name, a -> LuaE e ())] -> a -> LuaE e ()
pushAsTable
    [ (Name
"name", Name -> LuaE e ()
forall e. Name -> LuaE e ()
pushName (Name -> LuaE e ())
-> (DocumentedTypeWithList e a itemtype -> Name)
-> DocumentedTypeWithList e a itemtype
-> LuaE e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocumentedTypeWithList e a itemtype -> Name
forall e fn a. UDTypeGeneric e fn a -> Name
udName)
    , (Name
"properties", Map Name (Property e a) -> LuaE e ()
forall e a. LuaError e => Map Name (Property e a) -> LuaE e ()
pushPropertyDocs (Map Name (Property e a) -> LuaE e ())
-> (DocumentedTypeWithList e a itemtype -> Map Name (Property e a))
-> DocumentedTypeWithList e a itemtype
-> LuaE e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocumentedTypeWithList e a itemtype -> Map Name (Property e a)
forall e fn a. UDTypeGeneric e fn a -> Map Name (Property e a)
udProperties)
    ] DocumentedTypeWithList e a itemtype
ty
  StackIndex -> LuaE e ()
forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth CInt
3)

pushPropertyDocs :: LuaError e
                 => Map Name (Property e a)
                 -> LuaE e ()
pushPropertyDocs :: forall e a. LuaError e => Map Name (Property e a) -> LuaE e ()
pushPropertyDocs = Pusher e Name
-> Pusher e (Property e a) -> Pusher e [(Name, Property e a)]
forall e a b.
LuaError e =>
Pusher e a -> Pusher e b -> Pusher e [(a, b)]
pushKeyValuePairs Pusher e Name
forall e. Name -> LuaE e ()
pushName Pusher e (Property e a)
forall {e} {a}. Property e a -> LuaE e ()
pushPropDocs Pusher e [(Name, Property e a)]
-> (Map Name (Property e a) -> [(Name, Property e a)])
-> Map Name (Property e a)
-> LuaE e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Name (Property e a) -> [(Name, Property e a)]
forall k a. Map k a -> [(k, a)]
Map.toList
  where
    pushPropDocs :: Property e a -> LuaE e ()
pushPropDocs = [(Name, Property e a -> LuaE e ())] -> Property e a -> LuaE e ()
forall e a.
LuaError e =>
[(Name, a -> LuaE e ())] -> a -> LuaE e ()
pushAsTable
      [ (Name
"description", Pusher e Text
forall e. Pusher e Text
pushText Pusher e Text
-> (Property e a -> Text) -> Property e a -> LuaE e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Property e a -> Text
forall e a. Property e a -> Text
propertyDescription)
      , (Name
"type", TypeSpec -> LuaE e ()
forall e. LuaError e => TypeSpec -> LuaE e ()
pushTypeSpec (TypeSpec -> LuaE e ())
-> (Property e a -> TypeSpec) -> Property e a -> LuaE e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Property e a -> TypeSpec
forall e a. Property e a -> TypeSpec
propertyType)
      ]