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

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 :: Text -> Text -> Parameter e Bool
boolParam = Peeker e Bool -> Text -> Text -> Text -> Parameter e Bool
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e Bool
forall e. Peeker e Bool
peekBool Text
"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 :: Text -> Text -> Parameter e a
integralParam = Peeker e a -> Text -> Text -> Text -> Parameter e a
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e a
forall a e. (Integral a, Read a) => Peeker e a
peekIntegral Text
"integer"
{-# INLINE integralParam #-}

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

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


-- * Results

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

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

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

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