{-# LANGUAGE OverloadedStrings #-}
{-|
Module      : HsLua.Packaging.UDType
Copyright   : © 2020-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.Packaging.UDType
  ( DocumentedType
  , DocumentedTypeWithList
  , deftype
  , deftype'
  , method
  , property
  , property'
  , possibleProperty
  , possibleProperty'
  , readonly
  , readonly'
  , alias
  , operation
  , peekUD
  , pushUD
  , initType
  , udparam
  , udresult
  , udDocs
  , 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.Typing (pushTypeSpec)
import qualified Data.Map as Map

-- | Type definitions containing documented functions.
type DocumentedType e a = UDType e (DocumentedFunction e) 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 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 = forall e fn a.
Pusher e fn
-> Name -> [(Operation, fn)] -> [Member e fn a] -> UDType e fn a
deftypeGeneric forall e. LuaError e => DocumentedFunction e -> LuaE e ()
pushDocumentedFunction

-- | 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' = 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' forall e. LuaError e => DocumentedFunction e -> LuaE e ()
pushDocumentedFunction

-- | 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 = forall fn e a. Name -> fn -> Member e fn a
methodGeneric (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 forall a b. (a -> b) -> a -> b
$ forall e. Name -> DocumentedFunction e -> DocumentedFunction e
setName (Operation -> Name
metamethodName Operation
op) DocumentedFunction e
f

-- | 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 = forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter (forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> Peeker e a
peekUDGeneric DocumentedTypeWithList e a itemtype
ty) (forall e fn a itemtype. UDTypeWithList e fn a itemtype -> 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 = forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult (forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype -> a -> LuaE e ()
pushUD DocumentedTypeWithList e a itemtype
ty) (forall e fn a itemtype. UDTypeWithList e fn a itemtype -> 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 = forall e fn a itemtype.
LuaError e =>
(UDTypeWithList e fn a itemtype -> LuaE e ())
-> UDTypeWithList e fn a itemtype -> a -> LuaE e ()
pushUDGeneric forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype -> LuaE e ()
pushUDTypeDocs

-- | 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 = forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> Peeker e a
peekUDGeneric

-- | 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
         => DocumentedTypeWithList e a itemtype
         -> LuaE e Name
initType :: forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype -> LuaE e Name
initType = forall e fn a itemtype.
LuaError e =>
(UDTypeWithList e fn a itemtype -> LuaE e ())
-> UDTypeWithList e fn a itemtype -> LuaE e Name
initTypeGeneric forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype -> LuaE e ()
pushUDTypeDocs

-- | 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
  forall e. Name -> LuaE e ()
pushName Name
"docs"
  forall e a.
LuaError e =>
[(Name, a -> LuaE e ())] -> a -> LuaE e ()
pushAsTable
    [ (Name
"name", forall e. Name -> LuaE e ()
pushName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e fn a itemtype. UDTypeWithList e fn a itemtype -> Name
udName)
    , (Name
"properties", forall e a. LuaError e => Map Name (Property e a) -> LuaE e ()
pushPropertyDocs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e fn a itemtype.
UDTypeWithList e fn a itemtype -> Map Name (Property e a)
udProperties)
    ] DocumentedTypeWithList e a itemtype
ty
  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 = forall e a b.
LuaError e =>
Pusher e a -> Pusher e b -> Pusher e [(a, b)]
pushKeyValuePairs forall e. Name -> LuaE e ()
pushName forall {e} {a}. Property e a -> LuaE e ()
pushPropDocs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
Map.toList
  where
    pushPropDocs :: Property e a -> LuaE e ()
pushPropDocs = forall e a.
LuaError e =>
[(Name, a -> LuaE e ())] -> a -> LuaE e ()
pushAsTable
      [ (Name
"description", forall e. Pusher e Text
pushText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Property e a -> Text
propertyDescription)
      , (Name
"type", forall e. LuaError e => TypeSpec -> LuaE e ()
pushTypeSpec forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Property e a -> TypeSpec
propertyType)
      ]