{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE OverloadedStrings #-}
{-|
Module      : HsLua.Packaging.Function
Copyright   : © 2020-2021 Albert Krewinkel
License     : MIT
Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de>
Stability   : alpha
Portability : Portable

Marshaling and documenting Haskell functions.
-}
module HsLua.Packaging.Function
  ( DocumentedFunction (..)
    -- * Creating documented functions
  , defun
  , lambda
  , applyParameter
  , returnResult
  , returnResultsOnStack
  , liftPure
  , liftPure2
  , liftPure3
  , liftPure4
  , liftPure5
    -- ** Types
  , Parameter (..)
  , FunctionResult (..)
  , FunctionResults
    -- ** Operators
  , (###)
  , (<#>)
  , (=#>)
  , (=?>)
  , (#?)
    -- * Modifying functions
  , setName
  , since
    -- * Pushing to Lua
  , pushDocumentedFunction
    -- * Accessing documentation in Lua
  , docsField
  , pushDocumentation
    -- * Convenience functions
  , parameter
  , optionalParameter
  , functionResult
    -- * Internal
  , toHsFnPrecursor
  ) where

import Control.Applicative ((<|>))
import Control.Monad.Except
import Data.Text (Text)
import Data.Version (Version)
import HsLua.Core
import HsLua.Marshalling
import HsLua.Packaging.Rendering (renderFunction)
import HsLua.Packaging.Types
import qualified HsLua.Core as Lua
import qualified HsLua.Core.Utf8 as Utf8

#if !MIN_VERSION_base(4,12,0)
import Data.Semigroup (Semigroup ((<>)))
#endif

--
-- Haskell function building
--

-- | Helper type used to create 'HaskellFunction's.
data HsFnPrecursor e a = HsFnPrecursor
  { HsFnPrecursor e a -> Peek e a
hsFnPrecursorAction :: Peek e a
  , HsFnPrecursor e a -> StackIndex
hsFnMaxParameterIdx :: StackIndex
  , HsFnPrecursor e a -> [ParameterDoc]
hsFnParameterDocs :: [ParameterDoc]
  , HsFnPrecursor e a -> Name
hsFnName :: Name
  }
  deriving (a -> HsFnPrecursor e b -> HsFnPrecursor e a
(a -> b) -> HsFnPrecursor e a -> HsFnPrecursor e b
(forall a b. (a -> b) -> HsFnPrecursor e a -> HsFnPrecursor e b)
-> (forall a b. a -> HsFnPrecursor e b -> HsFnPrecursor e a)
-> Functor (HsFnPrecursor e)
forall a b. a -> HsFnPrecursor e b -> HsFnPrecursor e a
forall a b. (a -> b) -> HsFnPrecursor e a -> HsFnPrecursor e b
forall e a b. a -> HsFnPrecursor e b -> HsFnPrecursor e a
forall e a b. (a -> b) -> HsFnPrecursor e a -> HsFnPrecursor e b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> HsFnPrecursor e b -> HsFnPrecursor e a
$c<$ :: forall e a b. a -> HsFnPrecursor e b -> HsFnPrecursor e a
fmap :: (a -> b) -> HsFnPrecursor e a -> HsFnPrecursor e b
$cfmap :: forall e a b. (a -> b) -> HsFnPrecursor e a -> HsFnPrecursor e b
Functor)

-- | Result of a call to a Haskell function.
data FunctionResult e a
  = FunctionResult
  { FunctionResult e a -> Pusher e a
fnResultPusher  :: Pusher e a
  , FunctionResult e a -> ResultValueDoc
fnResultDoc     :: ResultValueDoc
  }

-- | List of function results in the order in which they are
-- returned in Lua.
type FunctionResults e a = [FunctionResult e a]

-- | Function parameter.
data Parameter e a = Parameter
  { Parameter e a -> Peeker e a
parameterPeeker :: Peeker e a
  , Parameter e a -> ParameterDoc
parameterDoc    :: ParameterDoc
  }


-- | Begin wrapping a monadic Lua function such that it can be turned
-- into a documented function exposable to Lua.
defun :: Name -> a -> HsFnPrecursor e a
defun :: Name -> a -> HsFnPrecursor e a
defun = StackIndex -> Name -> a -> HsFnPrecursor e a
forall a e. StackIndex -> Name -> a -> HsFnPrecursor e a
toHsFnPrecursor (CInt -> StackIndex
StackIndex CInt
0)

-- | Just like @defun@, but uses an empty name for the documented
-- function. Should be used when defining methods or operators.
lambda :: a -> HsFnPrecursor e a
lambda :: a -> HsFnPrecursor e a
lambda = Name -> a -> HsFnPrecursor e a
forall a e. Name -> a -> HsFnPrecursor e a
defun (ByteString -> Name
Name ByteString
forall a. Monoid a => a
mempty)

-- | Turns a pure function into a monadic Lua function.
--
-- The resulting function is strict.
liftPure :: (a -> b)
         -> (a -> LuaE e b)
liftPure :: (a -> b) -> a -> LuaE e b
liftPure a -> b
f !a
a = b -> LuaE e b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> LuaE e b) -> b -> LuaE e b
forall a b. (a -> b) -> a -> b
$! a -> b
f a
a

-- | Turns a binary function into a Lua function.
--
-- The resulting function is strict in both its arguments.
liftPure2 :: (a -> b -> c)
          -> (a -> b -> LuaE e c)
liftPure2 :: (a -> b -> c) -> a -> b -> LuaE e c
liftPure2 a -> b -> c
f !a
a !b
b = c -> LuaE e c
forall (m :: * -> *) a. Monad m => a -> m a
return (c -> LuaE e c) -> c -> LuaE e c
forall a b. (a -> b) -> a -> b
$! a -> b -> c
f a
a b
b

-- | Turns a ternary function into a Lua function.
--
-- The resulting function is strict in all of its arguments.
liftPure3 :: (a -> b -> c -> d)
          -> (a -> b -> c -> LuaE e d)
liftPure3 :: (a -> b -> c -> d) -> a -> b -> c -> LuaE e d
liftPure3 a -> b -> c -> d
f !a
a !b
b !c
c = d -> LuaE e d
forall (m :: * -> *) a. Monad m => a -> m a
return (d -> LuaE e d) -> d -> LuaE e d
forall a b. (a -> b) -> a -> b
$! a -> b -> c -> d
f a
a b
b c
c

-- | Turns a quarternary function into a Lua function.
--
-- The resulting function is strict in all of its arguments.
liftPure4 :: (a -> b -> c -> d -> e)
          -> (a -> b -> c -> d -> LuaE err e)
liftPure4 :: (a -> b -> c -> d -> e) -> a -> b -> c -> d -> LuaE err e
liftPure4 a -> b -> c -> d -> e
f !a
a !b
b !c
c !d
d = e -> LuaE err e
forall (m :: * -> *) a. Monad m => a -> m a
return (e -> LuaE err e) -> e -> LuaE err e
forall a b. (a -> b) -> a -> b
$! a -> b -> c -> d -> e
f a
a b
b c
c d
d

-- | Turns a quinary function into a Lua function.
--
-- The resulting function is strict in all of its arguments.
liftPure5 :: (a -> b -> c -> d -> e -> f)
          -> (a -> b -> c -> d -> e -> LuaE err f)
liftPure5 :: (a -> b -> c -> d -> e -> f) -> a -> b -> c -> d -> e -> LuaE err f
liftPure5 a -> b -> c -> d -> e -> f
f !a
a !b
b !c
c !d
d !e
e = f -> LuaE err f
forall (m :: * -> *) a. Monad m => a -> m a
return (f -> LuaE err f) -> f -> LuaE err f
forall a b. (a -> b) -> a -> b
$! a -> b -> c -> d -> e -> f
f a
a b
b c
c d
d e
e

-- | Create a HaskellFunction precursor from a monadic function,
-- selecting the stack index after which the first function parameter
-- will be placed.
toHsFnPrecursor :: StackIndex -> Name -> a -> HsFnPrecursor e a
toHsFnPrecursor :: StackIndex -> Name -> a -> HsFnPrecursor e a
toHsFnPrecursor StackIndex
idx Name
name a
f = HsFnPrecursor :: forall e a.
Peek e a
-> StackIndex -> [ParameterDoc] -> Name -> HsFnPrecursor e a
HsFnPrecursor
  { hsFnPrecursorAction :: Peek e a
hsFnPrecursorAction = a -> Peek e a
forall (m :: * -> *) a. Monad m => a -> m a
return a
f
  , hsFnMaxParameterIdx :: StackIndex
hsFnMaxParameterIdx = StackIndex
idx
  , hsFnParameterDocs :: [ParameterDoc]
hsFnParameterDocs = [ParameterDoc]
forall a. Monoid a => a
mempty
  , hsFnName :: Name
hsFnName = Name
name
  }

-- | Partially apply a parameter.
applyParameter :: HsFnPrecursor e (a -> b)
               -> Parameter e a
               -> HsFnPrecursor e b
applyParameter :: HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
applyParameter HsFnPrecursor e (a -> b)
bldr Parameter e a
param = do
  let action :: Peek e (a -> b)
action = HsFnPrecursor e (a -> b) -> Peek e (a -> b)
forall e a. HsFnPrecursor e a -> Peek e a
hsFnPrecursorAction HsFnPrecursor e (a -> b)
bldr
  let i :: StackIndex
i = HsFnPrecursor e (a -> b) -> StackIndex
forall e a. HsFnPrecursor e a -> StackIndex
hsFnMaxParameterIdx HsFnPrecursor e (a -> b)
bldr StackIndex -> StackIndex -> StackIndex
forall a. Num a => a -> a -> a
+ StackIndex
1
  let context :: Name
context = ByteString -> Name
Name (ByteString -> Name) -> (Text -> ByteString) -> Text -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Utf8.fromText (Text -> Name) -> Text -> Name
forall a b. (a -> b) -> a -> b
$ Text
"function argument " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        (ParameterDoc -> Text
parameterName (ParameterDoc -> Text)
-> (Parameter e a -> ParameterDoc) -> Parameter e a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parameter e a -> ParameterDoc
forall e a. Parameter e a -> ParameterDoc
parameterDoc) Parameter e a
param
  let nextAction :: (a -> a) -> Peek e a
nextAction a -> a
f = Name -> Peek e a -> Peek e a
forall e a. Name -> Peek e a -> Peek e a
withContext Name
context (Peek e a -> Peek e a) -> Peek e a -> Peek e a
forall a b. (a -> b) -> a -> b
$ do
        !a
x <- Parameter e a -> Peeker e a
forall e a. Parameter e a -> Peeker e a
parameterPeeker Parameter e a
param StackIndex
i
        a -> Peek e a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Peek e a) -> a -> Peek e a
forall a b. (a -> b) -> a -> b
$ a -> a
f a
x
  HsFnPrecursor e (a -> b)
bldr
    { hsFnPrecursorAction :: Peek e b
hsFnPrecursorAction = Peek e (a -> b)
action Peek e (a -> b) -> ((a -> b) -> Peek e b) -> Peek e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (a -> b) -> Peek e b
forall a. (a -> a) -> Peek e a
nextAction
    , hsFnMaxParameterIdx :: StackIndex
hsFnMaxParameterIdx = StackIndex
i
    , hsFnParameterDocs :: [ParameterDoc]
hsFnParameterDocs = Parameter e a -> ParameterDoc
forall e a. Parameter e a -> ParameterDoc
parameterDoc Parameter e a
param ParameterDoc -> [ParameterDoc] -> [ParameterDoc]
forall a. a -> [a] -> [a]
: HsFnPrecursor e (a -> b) -> [ParameterDoc]
forall e a. HsFnPrecursor e a -> [ParameterDoc]
hsFnParameterDocs HsFnPrecursor e (a -> b)
bldr
    }

-- | Take a 'HaskellFunction' precursor and convert it into a full
-- 'HaskellFunction', using the given 'FunctionResult's to return
-- the result to Lua.
returnResults :: HsFnPrecursor e (LuaE e a)
              -> FunctionResults e a
              -> DocumentedFunction e
returnResults :: HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
returnResults HsFnPrecursor e (LuaE e a)
bldr FunctionResults e a
fnResults = DocumentedFunction :: forall e.
LuaE e NumResults -> Name -> FunctionDoc -> DocumentedFunction e
DocumentedFunction
  { callFunction :: LuaE e NumResults
callFunction = do
      Result (LuaE e a)
hsResult <- Peek e (LuaE e a) -> LuaE e (Result (LuaE e a))
forall e a. Peek e a -> LuaE e (Result a)
runPeek
                (Peek e (LuaE e a) -> LuaE e (Result (LuaE e a)))
-> (Peek e (LuaE e a) -> Peek e (LuaE e a))
-> Peek e (LuaE e a)
-> LuaE e (Result (LuaE e a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Peek e (LuaE e a) -> Peek e (LuaE e a)
forall e a. Name -> Peek e a -> Peek e a
retrieving (Name
"arguments for function " Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> HsFnPrecursor e (LuaE e a) -> Name
forall e a. HsFnPrecursor e a -> Name
hsFnName HsFnPrecursor e (LuaE e a)
bldr)
                (Peek e (LuaE e a) -> LuaE e (Result (LuaE e a)))
-> Peek e (LuaE e a) -> LuaE e (Result (LuaE e a))
forall a b. (a -> b) -> a -> b
$ HsFnPrecursor e (LuaE e a) -> Peek e (LuaE e a)
forall e a. HsFnPrecursor e a -> Peek e a
hsFnPrecursorAction HsFnPrecursor e (LuaE e a)
bldr
      case Result (LuaE e a) -> Either String (LuaE e a)
forall a. Result a -> Either String a
resultToEither Result (LuaE e a)
hsResult of
        Left String
err -> do
          String -> LuaE e ()
forall e. String -> LuaE e ()
pushString String
err
          LuaE e NumResults
forall e. LuaE e NumResults
Lua.error
        Right LuaE e a
x -> do
          a
result <- LuaE e a
x
          FunctionResults e a
-> (FunctionResult e a -> LuaE e ()) -> LuaE e ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ FunctionResults e a
fnResults ((FunctionResult e a -> LuaE e ()) -> LuaE e ())
-> (FunctionResult e a -> LuaE e ()) -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ \(FunctionResult Pusher e a
push ResultValueDoc
_) -> Pusher e a
push a
result
          NumResults -> LuaE e NumResults
forall (m :: * -> *) a. Monad m => a -> m a
return (NumResults -> LuaE e NumResults)
-> NumResults -> LuaE e NumResults
forall a b. (a -> b) -> a -> b
$! CInt -> NumResults
NumResults (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ FunctionResults e a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FunctionResults e a
fnResults)
  , functionName :: Name
functionName = HsFnPrecursor e (LuaE e a) -> Name
forall e a. HsFnPrecursor e a -> Name
hsFnName HsFnPrecursor e (LuaE e a)
bldr
  , functionDoc :: FunctionDoc
functionDoc = FunctionDoc :: Text
-> [ParameterDoc] -> ResultsDoc -> Maybe Version -> FunctionDoc
FunctionDoc
    { functionDescription :: Text
functionDescription = Text
""
    , parameterDocs :: [ParameterDoc]
parameterDocs = [ParameterDoc] -> [ParameterDoc]
forall a. [a] -> [a]
reverse ([ParameterDoc] -> [ParameterDoc])
-> [ParameterDoc] -> [ParameterDoc]
forall a b. (a -> b) -> a -> b
$ HsFnPrecursor e (LuaE e a) -> [ParameterDoc]
forall e a. HsFnPrecursor e a -> [ParameterDoc]
hsFnParameterDocs HsFnPrecursor e (LuaE e a)
bldr
    , functionResultsDocs :: ResultsDoc
functionResultsDocs = [ResultValueDoc] -> ResultsDoc
ResultsDocList ([ResultValueDoc] -> ResultsDoc) -> [ResultValueDoc] -> ResultsDoc
forall a b. (a -> b) -> a -> b
$ (FunctionResult e a -> ResultValueDoc)
-> FunctionResults e a -> [ResultValueDoc]
forall a b. (a -> b) -> [a] -> [b]
map FunctionResult e a -> ResultValueDoc
forall e a. FunctionResult e a -> ResultValueDoc
fnResultDoc FunctionResults e a
fnResults
    , functionSince :: Maybe Version
functionSince = Maybe Version
forall a. Maybe a
Nothing
    }
  }

-- | Take a 'HaskellFunction' precursor and convert it into a full
-- 'HaskellFunction', using the given 'FunctionResult's to return
-- the result to Lua.
returnResultsOnStack :: HsFnPrecursor e (LuaE e NumResults)
                     -> Text
                     -> DocumentedFunction e
returnResultsOnStack :: HsFnPrecursor e (LuaE e NumResults) -> Text -> DocumentedFunction e
returnResultsOnStack HsFnPrecursor e (LuaE e NumResults)
bldr Text
desc = DocumentedFunction :: forall e.
LuaE e NumResults -> Name -> FunctionDoc -> DocumentedFunction e
DocumentedFunction
  { callFunction :: LuaE e NumResults
callFunction = do
      Result (LuaE e NumResults)
hsResult <- Peek e (LuaE e NumResults) -> LuaE e (Result (LuaE e NumResults))
forall e a. Peek e a -> LuaE e (Result a)
runPeek
                (Peek e (LuaE e NumResults) -> LuaE e (Result (LuaE e NumResults)))
-> (Peek e (LuaE e NumResults) -> Peek e (LuaE e NumResults))
-> Peek e (LuaE e NumResults)
-> LuaE e (Result (LuaE e NumResults))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Peek e (LuaE e NumResults) -> Peek e (LuaE e NumResults)
forall e a. Name -> Peek e a -> Peek e a
retrieving (Name
"arguments for function " Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> HsFnPrecursor e (LuaE e NumResults) -> Name
forall e a. HsFnPrecursor e a -> Name
hsFnName HsFnPrecursor e (LuaE e NumResults)
bldr)
                (Peek e (LuaE e NumResults) -> LuaE e (Result (LuaE e NumResults)))
-> Peek e (LuaE e NumResults)
-> LuaE e (Result (LuaE e NumResults))
forall a b. (a -> b) -> a -> b
$ HsFnPrecursor e (LuaE e NumResults) -> Peek e (LuaE e NumResults)
forall e a. HsFnPrecursor e a -> Peek e a
hsFnPrecursorAction HsFnPrecursor e (LuaE e NumResults)
bldr
      case Result (LuaE e NumResults) -> Either String (LuaE e NumResults)
forall a. Result a -> Either String a
resultToEither Result (LuaE e NumResults)
hsResult of
        Left String
err -> do
          String -> LuaE e ()
forall e. String -> LuaE e ()
pushString String
err
          LuaE e NumResults
forall e. LuaE e NumResults
Lua.error
        Right LuaE e NumResults
x -> LuaE e NumResults
x
  , functionName :: Name
functionName = HsFnPrecursor e (LuaE e NumResults) -> Name
forall e a. HsFnPrecursor e a -> Name
hsFnName HsFnPrecursor e (LuaE e NumResults)
bldr
  , functionDoc :: FunctionDoc
functionDoc = FunctionDoc :: Text
-> [ParameterDoc] -> ResultsDoc -> Maybe Version -> FunctionDoc
FunctionDoc
    { functionDescription :: Text
functionDescription = Text
""
    , parameterDocs :: [ParameterDoc]
parameterDocs = [ParameterDoc] -> [ParameterDoc]
forall a. [a] -> [a]
reverse ([ParameterDoc] -> [ParameterDoc])
-> [ParameterDoc] -> [ParameterDoc]
forall a b. (a -> b) -> a -> b
$ HsFnPrecursor e (LuaE e NumResults) -> [ParameterDoc]
forall e a. HsFnPrecursor e a -> [ParameterDoc]
hsFnParameterDocs HsFnPrecursor e (LuaE e NumResults)
bldr
    , functionResultsDocs :: ResultsDoc
functionResultsDocs = Text -> ResultsDoc
ResultsDocMult Text
desc
    , functionSince :: Maybe Version
functionSince = Maybe Version
forall a. Maybe a
Nothing
    }
  }

-- | Like @'returnResult'@, but returns only a single result.
returnResult :: HsFnPrecursor e (LuaE e a)
             -> FunctionResult e a
             -> DocumentedFunction e
returnResult :: HsFnPrecursor e (LuaE e a)
-> FunctionResult e a -> DocumentedFunction e
returnResult HsFnPrecursor e (LuaE e a)
bldr = HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
returnResults HsFnPrecursor e (LuaE e a)
bldr (FunctionResults e a -> DocumentedFunction e)
-> (FunctionResult e a -> FunctionResults e a)
-> FunctionResult e a
-> DocumentedFunction e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FunctionResult e a -> FunctionResults e a -> FunctionResults e a
forall a. a -> [a] -> [a]
:[])

-- | Updates the description of a Haskell function. Leaves the function
-- unchanged if it has no documentation.
updateFunctionDescription :: DocumentedFunction e
                          -> Text
                          -> DocumentedFunction e
updateFunctionDescription :: DocumentedFunction e -> Text -> DocumentedFunction e
updateFunctionDescription DocumentedFunction e
fn Text
desc =
  let fnDoc :: FunctionDoc
fnDoc = DocumentedFunction e -> FunctionDoc
forall e. DocumentedFunction e -> FunctionDoc
functionDoc DocumentedFunction e
fn
  in DocumentedFunction e
fn { functionDoc :: FunctionDoc
functionDoc = FunctionDoc
fnDoc { functionDescription :: Text
functionDescription = Text
desc} }

-- | Renames a documented function.
setName :: Name -> DocumentedFunction e -> DocumentedFunction e
setName :: Name -> DocumentedFunction e -> DocumentedFunction e
setName Name
name DocumentedFunction e
fn = DocumentedFunction e
fn { functionName :: Name
functionName = Name
name }

-- | Sets the library version at which the function was introduced in its
-- current form.
since :: DocumentedFunction e -> Version -> DocumentedFunction e
since :: DocumentedFunction e -> Version -> DocumentedFunction e
since DocumentedFunction e
fn Version
version =
  let fnDoc :: FunctionDoc
fnDoc = DocumentedFunction e -> FunctionDoc
forall e. DocumentedFunction e -> FunctionDoc
functionDoc DocumentedFunction e
fn
  in DocumentedFunction e
fn { functionDoc :: FunctionDoc
functionDoc = FunctionDoc
fnDoc { functionSince :: Maybe Version
functionSince = Version -> Maybe Version
forall a. a -> Maybe a
Just Version
version  }}

--
-- Operators
--

infixl 8 ###, <#>, =#>, =?>, #?, `since`

-- | Like '($)', but left associative.
(###) :: (a -> HsFnPrecursor e a) -> a -> HsFnPrecursor e a
### :: (a -> HsFnPrecursor e a) -> a -> HsFnPrecursor e a
(###) = (a -> HsFnPrecursor e a) -> a -> HsFnPrecursor e a
forall a b. (a -> b) -> a -> b
($)

-- | Inline version of @'applyParameter'@.
(<#>) :: HsFnPrecursor e (a -> b)
      -> Parameter e a
      -> HsFnPrecursor e b
<#> :: HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
(<#>) = HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
applyParameter

-- | Inline version of @'returnResults'@.
(=#>) :: HsFnPrecursor e (LuaE e a)
      -> FunctionResults e a
      -> DocumentedFunction e
=#> :: HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
(=#>) = HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
returnResults

-- | Return a flexible number of results that have been pushed by the
-- function action.
(=?>) :: HsFnPrecursor e (LuaE e NumResults)
      -> Text
      -> DocumentedFunction e
=?> :: HsFnPrecursor e (LuaE e NumResults) -> Text -> DocumentedFunction e
(=?>) = HsFnPrecursor e (LuaE e NumResults) -> Text -> DocumentedFunction e
forall e.
HsFnPrecursor e (LuaE e NumResults) -> Text -> DocumentedFunction e
returnResultsOnStack

-- | Inline version of @'updateFunctionDescription'@.
(#?) :: DocumentedFunction e -> Text -> DocumentedFunction e
#? :: DocumentedFunction e -> Text -> DocumentedFunction e
(#?) = DocumentedFunction e -> Text -> DocumentedFunction e
forall e. DocumentedFunction e -> Text -> DocumentedFunction e
updateFunctionDescription

--
-- Push to Lua
--

-- | Name of the registry field holding the documentation table. The
-- documentation table is indexed by the documented objects, like module
-- tables and functions, and contains documentation strings as values.
--
-- The table is an ephemeron table, i.e., an entry gets garbage
-- collected if the key is no longer reachable.
docsField :: Name
docsField :: Name
docsField = Name
"HsLua docs"

-- | Pushes a documented Haskell function to the Lua stack, making it
-- usable as a normal function in Lua. At the same time, the function
-- docs are registered in the documentation table.
pushDocumentedFunction :: LuaError e
                       => DocumentedFunction e -> LuaE e ()
pushDocumentedFunction :: DocumentedFunction e -> LuaE e ()
pushDocumentedFunction DocumentedFunction e
fn = do
  -- push function
  HaskellFunction e -> LuaE e ()
forall e. LuaError e => HaskellFunction e -> LuaE e ()
Lua.pushHaskellFunction (HaskellFunction e -> LuaE e ()) -> HaskellFunction e -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ DocumentedFunction e -> HaskellFunction e
forall e. DocumentedFunction e -> LuaE e NumResults
callFunction DocumentedFunction e
fn

  -- store documentation
  StackIndex -> Name -> LuaE e Type
forall e. LuaError e => StackIndex -> Name -> LuaE e Type
Lua.getfield StackIndex
registryindex Name
docsField LuaE e Type -> (Type -> LuaE e ()) -> LuaE e ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Type
TypeTable -> () -> LuaE e ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- already have the documentation table
    Type
_ -> do
      Int -> LuaE e ()
forall e. Int -> LuaE e ()
Lua.pop Int
1            -- pop non-table value
      LuaE e ()
forall e. LuaE e ()
Lua.newtable         -- create documentation table
      ByteString -> LuaE e ()
forall e. ByteString -> LuaE e ()
Lua.pushstring ByteString
"k"   -- Make it an "ephemeron table" and..
      StackIndex -> Name -> LuaE e ()
forall e. LuaError e => StackIndex -> Name -> LuaE e ()
Lua.setfield (CInt -> StackIndex
nth CInt
2) Name
"__mode"  -- collect docs if function is GCed
      StackIndex -> LuaE e ()
forall e. StackIndex -> LuaE e ()
Lua.pushvalue StackIndex
top    -- add copy of table to registry
      StackIndex -> Name -> LuaE e ()
forall e. LuaError e => StackIndex -> Name -> LuaE e ()
Lua.setfield StackIndex
registryindex Name
docsField
  StackIndex -> LuaE e ()
forall e. StackIndex -> LuaE e ()
Lua.pushvalue (CInt -> StackIndex
nth CInt
2)  -- the function
  Pusher e Text
forall e. Pusher e Text
pushText Pusher e Text -> Pusher e Text
forall a b. (a -> b) -> a -> b
$ DocumentedFunction e -> Text
forall e. DocumentedFunction e -> Text
renderFunction DocumentedFunction e
fn
  StackIndex -> LuaE e ()
forall e. LuaError e => StackIndex -> LuaE e ()
Lua.rawset (CInt -> StackIndex
nth CInt
3)
  Int -> LuaE e ()
forall e. Int -> LuaE e ()
Lua.pop Int
1              -- pop doc table, leave function on stack

-- | Pushes the documentation of the object at the given index to the
-- stack, or just *nil* if no documentation is available.
pushDocumentation :: LuaError e => StackIndex -> LuaE e NumResults
pushDocumentation :: StackIndex -> LuaE e NumResults
pushDocumentation StackIndex
idx = do
  StackIndex
idx' <- StackIndex -> LuaE e StackIndex
forall e. StackIndex -> LuaE e StackIndex
Lua.absindex StackIndex
idx
  StackIndex -> Name -> LuaE e Type
forall e. LuaError e => StackIndex -> Name -> LuaE e Type
Lua.getfield StackIndex
registryindex Name
docsField LuaE e Type -> (Type -> LuaE e ()) -> LuaE e ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Type
TypeTable -> do
      StackIndex -> LuaE e ()
forall e. StackIndex -> LuaE e ()
Lua.pushvalue StackIndex
idx'
      StackIndex -> LuaE e ()
forall e. LuaError e => StackIndex -> LuaE e ()
Lua.rawget (CInt -> StackIndex
nth CInt
2)
    Type
_ -> do -- no documentation table available
      Int -> LuaE e ()
forall e. Int -> LuaE e ()
Lua.pop Int
1    -- pop contents of docsField
      LuaE e ()
forall e. LuaE e ()
Lua.pushnil
  NumResults -> LuaE e NumResults
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> NumResults
NumResults CInt
1)

--
-- Convenience functions
--

-- | Creates a parameter.
parameter :: Peeker e a   -- ^ method to retrieve value from Lua
          -> Text         -- ^ expected Lua type
          -> Text         -- ^ parameter name
          -> Text         -- ^ parameter description
          -> Parameter e a
parameter :: Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e a
peeker Text
type_ Text
name Text
desc = Parameter :: forall e a. Peeker e a -> ParameterDoc -> Parameter e a
Parameter
  { parameterPeeker :: Peeker e a
parameterPeeker = Peeker e a
peeker
  , parameterDoc :: ParameterDoc
parameterDoc = ParameterDoc :: Text -> Text -> Text -> Bool -> ParameterDoc
ParameterDoc
    { parameterName :: Text
parameterName = Text
name
    , parameterDescription :: Text
parameterDescription = Text
desc
    , parameterType :: Text
parameterType = Text
type_
    , parameterIsOptional :: Bool
parameterIsOptional = Bool
False
    }
  }

-- | Creates an optional parameter.
optionalParameter :: Peeker e a   -- ^ method to retrieve the value from Lua
                  -> Text         -- ^ expected Lua type
                  -> Text         -- ^ parameter name
                  -> Text         -- ^ parameter description
                  -> Parameter e (Maybe a)
optionalParameter :: Peeker e a -> Text -> Text -> Text -> Parameter e (Maybe a)
optionalParameter Peeker e a
peeker Text
type_ Text
name Text
desc = Parameter :: forall e a. Peeker e a -> ParameterDoc -> Parameter e a
Parameter
  { parameterPeeker :: Peeker e (Maybe a)
parameterPeeker = \StackIndex
idx -> (Maybe a
forall a. Maybe a
Nothing Maybe a -> Peek e () -> Peek e (Maybe a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Peeker e ()
forall e. Peeker e ()
peekNoneOrNil StackIndex
idx)
                          Peek e (Maybe a) -> Peek e (Maybe a) -> Peek e (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Peek e a -> Peek e (Maybe a)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e a
peeker StackIndex
idx)
  , parameterDoc :: ParameterDoc
parameterDoc = ParameterDoc :: Text -> Text -> Text -> Bool -> ParameterDoc
ParameterDoc
    { parameterName :: Text
parameterName = Text
name
    , parameterDescription :: Text
parameterDescription = Text
desc
    , parameterType :: Text
parameterType = Text
type_
    , parameterIsOptional :: Bool
parameterIsOptional = Bool
True
    }
  }

-- | Creates a function result.
functionResult :: Pusher e a      -- ^ method to push the Haskell result to Lua
               -> Text            -- ^ Lua type of result
               -> Text            -- ^ result description
               -> FunctionResults e a
functionResult :: Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e a
pusher Text
type_ Text
desc = (FunctionResult e a -> FunctionResults e a -> FunctionResults e a
forall a. a -> [a] -> [a]
:[]) (FunctionResult e a -> FunctionResults e a)
-> FunctionResult e a -> FunctionResults e a
forall a b. (a -> b) -> a -> b
$ FunctionResult :: forall e a. Pusher e a -> ResultValueDoc -> FunctionResult e a
FunctionResult
  { fnResultPusher :: Pusher e a
fnResultPusher = Pusher e a
pusher
  , fnResultDoc :: ResultValueDoc
fnResultDoc = ResultValueDoc :: Text -> Text -> ResultValueDoc
ResultValueDoc
                  { resultValueType :: Text
resultValueType = Text
type_
                  , resultValueDescription :: Text
resultValueDescription = Text
desc
                  }
  }