{-# LANGUAGE OverloadedStrings #-}
{-|
Module      : HsLua.Packaging.Convenience
Copyright   : © 2021-2024 Albert Krewinkel
License     : MIT
Maintainer  : Albert Krewinkel <tarleb@hslua.org>

Convenience functions for common parameter and result types.
-}
module HsLua.Packaging.Convenience
where

import Data.Text (Text)
import HsLua.Marshalling
import HsLua.Packaging.Function

-- * Parameters

-- | Defines a function parameter of type 'Bool'.
boolParam :: Text -- ^ parameter name
          -> Text -- ^ parameter description
          -> Parameter e Bool
boolParam :: forall e. Text -> Text -> Parameter e Bool
boolParam = Peeker e Bool -> TypeSpec -> Text -> Text -> Parameter e Bool
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e Bool
forall e. Peeker e Bool
peekBool TypeSpec
"boolean"
{-# INLINE boolParam #-}

-- | Defines a function parameter for an integral type.
integralParam :: (Read a, Integral a)
              => Text -- ^ parameter name
              -> Text -- ^ parameter description
              -> Parameter e a
integralParam :: forall a e. (Read a, Integral a) => Text -> Text -> Parameter e a
integralParam = Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e a
forall a e. (Integral a, Read a) => Peeker e a
peekIntegral TypeSpec
"integer"
{-# INLINE integralParam #-}

-- | Defines a function parameter of type 'String'.
stringParam :: Text -- ^ parameter name
            -> Text -- ^ parameter description
            -> Parameter e String
stringParam :: forall e. Text -> Text -> Parameter e String
stringParam = Peeker e String -> TypeSpec -> Text -> Text -> Parameter e String
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e String
forall e. Peeker e String
peekString TypeSpec
"string"
{-# INLINE stringParam #-}

-- | Defines a function parameter of type 'Text'.
textParam :: Text -- ^ parameter name
          -> Text -- ^ parameter description
          -> Parameter e Text
textParam :: forall e. Text -> Text -> Parameter e Text
textParam = Peeker e Text -> TypeSpec -> Text -> Text -> Parameter e Text
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e Text
forall e. Peeker e Text
peekText TypeSpec
"string"
{-# INLINE textParam #-}


-- * Results

-- | Defines a function result of type 'Bool'.
boolResult :: Text -- ^ result description
           -> FunctionResults e Bool
boolResult :: forall e. Text -> FunctionResults e Bool
boolResult = Pusher e Bool -> TypeSpec -> Text -> FunctionResults e Bool
forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult Pusher e Bool
forall e. Pusher e Bool
pushBool TypeSpec
"boolean"
{-# INLINE boolResult #-}

-- | Defines a function result for an integral type.
integralResult :: (Integral a, Show a)
               => Text -- ^ result description
               -> FunctionResults e a
integralResult :: forall a e. (Integral a, Show a) => Text -> FunctionResults e a
integralResult = Pusher e a -> TypeSpec -> Text -> FunctionResults e a
forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult Pusher e a
forall a e. (Integral a, Show a) => a -> LuaE e ()
pushIntegral TypeSpec
"integer|string"
{-# INLINE integralResult #-}

-- | Defines a function result of type 'Text'.
stringResult :: Text -- ^ result description
             -> FunctionResults e String
stringResult :: forall e. Text -> FunctionResults e String
stringResult = Pusher e String -> TypeSpec -> Text -> FunctionResults e String
forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult Pusher e String
forall e. String -> LuaE e ()
pushString TypeSpec
"string"
{-# INLINE stringResult #-}

-- | Defines a function result of type 'Text'.
textResult :: Text -- ^ result description
           -> FunctionResults e Text
textResult :: forall e. Text -> FunctionResults e Text
textResult = Pusher e Text -> TypeSpec -> Text -> FunctionResults e Text
forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult Pusher e Text
forall e. Pusher e Text
pushText TypeSpec
"string"
{-# INLINE textResult #-}