{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE OverloadedStrings #-}
module HsLua.Packaging.Function
( DocumentedFunction (..)
, defun
, lambda
, applyParameter
, returnResult
, returnResults
, returnResultsOnStack
, updateFunctionDescription
, liftPure
, liftPure2
, liftPure3
, liftPure4
, liftPure5
, Parameter (..)
, FunctionResult (..)
, FunctionResults
, (###)
, (<#>)
, (=#>)
, (=?>)
, (#?)
, setName
, since
, pushDocumentedFunction
, parameter
, opt
, optionalParameter
, functionResult
, HsFnPrecursor
, toHsFnPrecursor
) where
import Control.Applicative ((<|>))
import Control.Monad ((<$!>), forM_)
import Data.Text (Text)
import Data.Version (Version)
import HsLua.Core
import HsLua.Marshalling
import HsLua.Packaging.Documentation
import HsLua.Packaging.Types
import HsLua.Typing (TypeSpec)
import qualified HsLua.Core as Lua
import qualified HsLua.Core.Utf8 as Utf8
data HsFnPrecursor e a = HsFnPrecursor
{ forall e a. HsFnPrecursor e a -> Peek e a
hsFnPrecursorAction :: Peek e a
, forall e a. HsFnPrecursor e a -> StackIndex
hsFnMaxParameterIdx :: StackIndex
, forall e a. HsFnPrecursor e a -> [ParameterDoc]
hsFnParameterDocs :: [ParameterDoc]
, forall e a. HsFnPrecursor e a -> Name
hsFnName :: Name
}
deriving (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
<$ :: forall a b. a -> HsFnPrecursor e b -> HsFnPrecursor e a
$c<$ :: forall e a b. a -> HsFnPrecursor e b -> HsFnPrecursor e a
fmap :: forall a b. (a -> b) -> HsFnPrecursor e a -> HsFnPrecursor e b
$cfmap :: forall e a b. (a -> b) -> HsFnPrecursor e a -> HsFnPrecursor e b
Functor)
data FunctionResult e a
= FunctionResult
{ forall e a. FunctionResult e a -> Pusher e a
fnResultPusher :: Pusher e a
, forall e a. FunctionResult e a -> ResultValueDoc
fnResultDoc :: ResultValueDoc
}
type FunctionResults e a = [FunctionResult e a]
data Parameter e a = Parameter
{ forall e a. Parameter e a -> Peeker e a
parameterPeeker :: Peeker e a
, forall e a. Parameter e a -> ParameterDoc
parameterDoc :: ParameterDoc
}
defun :: Name -> a -> HsFnPrecursor e a
defun :: forall a e. Name -> a -> HsFnPrecursor e a
defun = forall a e. StackIndex -> Name -> a -> HsFnPrecursor e a
toHsFnPrecursor (CInt -> StackIndex
StackIndex CInt
0)
lambda :: a -> HsFnPrecursor e a
lambda :: forall a e. a -> HsFnPrecursor e a
lambda = forall a e. Name -> a -> HsFnPrecursor e a
defun (ByteString -> Name
Name forall a. Monoid a => a
mempty)
liftPure :: (a -> b)
-> (a -> LuaE e b)
liftPure :: forall a b e. (a -> b) -> a -> LuaE e b
liftPure a -> b
f !a
a = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! a -> b
f a
a
liftPure2 :: (a -> b -> c)
-> (a -> b -> LuaE e c)
liftPure2 :: forall a b c e. (a -> b -> c) -> a -> b -> LuaE e c
liftPure2 a -> b -> c
f !a
a !b
b = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! a -> b -> c
f a
a b
b
liftPure3 :: (a -> b -> c -> d)
-> (a -> b -> c -> LuaE e d)
liftPure3 :: forall a b c d e. (a -> b -> c -> d) -> a -> b -> c -> LuaE e d
liftPure3 a -> b -> c -> d
f !a
a !b
b !c
c = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! a -> b -> c -> d
f a
a b
b c
c
liftPure4 :: (a -> b -> c -> d -> e)
-> (a -> b -> c -> d -> LuaE err e)
liftPure4 :: forall a b c d e err.
(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 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! a -> b -> c -> d -> e
f a
a b
b c
c d
d
liftPure5 :: (a -> b -> c -> d -> e -> f)
-> (a -> b -> c -> d -> e -> LuaE err f)
liftPure5 :: forall a b c d e f err.
(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 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! a -> b -> c -> d -> e -> f
f a
a b
b c
c d
d e
e
toHsFnPrecursor :: StackIndex -> Name -> a -> HsFnPrecursor e a
toHsFnPrecursor :: forall a e. StackIndex -> Name -> a -> HsFnPrecursor e a
toHsFnPrecursor StackIndex
idx Name
name a
f = HsFnPrecursor
{ hsFnPrecursorAction :: Peek e a
hsFnPrecursorAction = forall (m :: * -> *) a. Monad m => a -> m a
return a
f
, hsFnMaxParameterIdx :: StackIndex
hsFnMaxParameterIdx = StackIndex
idx
, hsFnParameterDocs :: [ParameterDoc]
hsFnParameterDocs = forall a. Monoid a => a
mempty
, hsFnName :: Name
hsFnName = Name
name
}
applyParameter :: HsFnPrecursor e (a -> b)
-> Parameter e a
-> HsFnPrecursor e b
applyParameter :: forall e a b.
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 = forall e a. HsFnPrecursor e a -> Peek e a
hsFnPrecursorAction HsFnPrecursor e (a -> b)
bldr
let i :: StackIndex
i = forall e a. HsFnPrecursor e a -> StackIndex
hsFnMaxParameterIdx HsFnPrecursor e (a -> b)
bldr forall a. Num a => a -> a -> a
+ StackIndex
1
let context :: Name
context = ByteString -> Name
Name forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Utf8.fromText forall a b. (a -> b) -> a -> b
$ Text
"function argument " forall a. Semigroup a => a -> a -> a
<>
(ParameterDoc -> Text
parameterName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Parameter e a -> ParameterDoc
parameterDoc) Parameter e a
param
let nextAction :: (a -> a) -> Peek e a
nextAction a -> a
f = forall e a. Name -> Peek e a -> Peek e a
retrieving Name
context forall a b. (a -> b) -> a -> b
$ do
!a
x <- forall e a. Parameter e a -> Peeker e a
parameterPeeker Parameter e a
param StackIndex
i
forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {a}. (a -> a) -> Peek e a
nextAction
, hsFnMaxParameterIdx :: StackIndex
hsFnMaxParameterIdx = StackIndex
i
, hsFnParameterDocs :: [ParameterDoc]
hsFnParameterDocs = forall e a. Parameter e a -> ParameterDoc
parameterDoc Parameter e a
param forall a. a -> [a] -> [a]
: forall e a. HsFnPrecursor e a -> [ParameterDoc]
hsFnParameterDocs HsFnPrecursor e (a -> b)
bldr
}
returnResults :: HsFnPrecursor e (LuaE e a)
-> FunctionResults e a
-> DocumentedFunction e
returnResults :: forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
returnResults HsFnPrecursor e (LuaE e a)
bldr FunctionResults e a
fnResults = DocumentedFunction
{ callFunction :: LuaE e NumResults
callFunction = do
Result (LuaE e a)
hsResult <- forall e a. Peek e a -> LuaE e (Result a)
runPeek
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Name -> Peek e a -> Peek e a
retrieving (Name
"arguments for function " forall a. Semigroup a => a -> a -> a
<> forall e a. HsFnPrecursor e a -> Name
hsFnName HsFnPrecursor e (LuaE e a)
bldr)
forall a b. (a -> b) -> a -> b
$ forall e a. HsFnPrecursor e a -> Peek e a
hsFnPrecursorAction HsFnPrecursor e (LuaE e a)
bldr
case forall a. Result a -> Either String a
resultToEither Result (LuaE e a)
hsResult of
Left String
err -> do
forall e. String -> LuaE e ()
pushString String
err
forall e. LuaE e NumResults
Lua.error
Right LuaE e a
x -> do
a
result <- LuaE e a
x
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ FunctionResults e a
fnResults forall a b. (a -> b) -> a -> b
$ \(FunctionResult Pusher e a
push ResultValueDoc
_) -> Pusher e a
push a
result
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! CInt -> NumResults
NumResults (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length FunctionResults e a
fnResults)
, functionName :: Name
functionName = forall e a. HsFnPrecursor e a -> Name
hsFnName HsFnPrecursor e (LuaE e a)
bldr
, functionDoc :: FunctionDoc
functionDoc = FunctionDoc
{ functionDescription :: Text
functionDescription = Text
""
, parameterDocs :: [ParameterDoc]
parameterDocs = forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall e a. HsFnPrecursor e a -> [ParameterDoc]
hsFnParameterDocs HsFnPrecursor e (LuaE e a)
bldr
, functionResultsDocs :: ResultsDoc
functionResultsDocs = [ResultValueDoc] -> ResultsDoc
ResultsDocList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall e a. FunctionResult e a -> ResultValueDoc
fnResultDoc FunctionResults e a
fnResults
, functionSince :: Maybe Version
functionSince = forall a. Maybe a
Nothing
}
}
returnResultsOnStack :: HsFnPrecursor e (LuaE e NumResults)
-> Text
-> DocumentedFunction e
returnResultsOnStack :: forall e.
HsFnPrecursor e (LuaE e NumResults) -> Text -> DocumentedFunction e
returnResultsOnStack HsFnPrecursor e (LuaE e NumResults)
bldr Text
desc = DocumentedFunction
{ callFunction :: LuaE e NumResults
callFunction = do
Result (LuaE e NumResults)
hsResult <- forall e a. Peek e a -> LuaE e (Result a)
runPeek
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Name -> Peek e a -> Peek e a
retrieving (Name
"arguments for function " forall a. Semigroup a => a -> a -> a
<> forall e a. HsFnPrecursor e a -> Name
hsFnName HsFnPrecursor e (LuaE e NumResults)
bldr)
forall a b. (a -> b) -> a -> b
$ forall e a. HsFnPrecursor e a -> Peek e a
hsFnPrecursorAction HsFnPrecursor e (LuaE e NumResults)
bldr
case forall a. Result a -> Either String a
resultToEither Result (LuaE e NumResults)
hsResult of
Left String
err -> do
forall e. String -> LuaE e ()
pushString String
err
forall e. LuaE e NumResults
Lua.error
Right LuaE e NumResults
x -> LuaE e NumResults
x
, functionName :: Name
functionName = forall e a. HsFnPrecursor e a -> Name
hsFnName HsFnPrecursor e (LuaE e NumResults)
bldr
, functionDoc :: FunctionDoc
functionDoc = FunctionDoc
{ functionDescription :: Text
functionDescription = Text
""
, parameterDocs :: [ParameterDoc]
parameterDocs = forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ 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 = forall a. Maybe a
Nothing
}
}
returnResult :: HsFnPrecursor e (LuaE e a)
-> FunctionResult e a
-> DocumentedFunction e
returnResult :: forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResult e a -> DocumentedFunction e
returnResult HsFnPrecursor e (LuaE e a)
bldr = forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
returnResults HsFnPrecursor e (LuaE e a)
bldr forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[])
updateFunctionDescription :: DocumentedFunction e
-> Text
-> DocumentedFunction e
updateFunctionDescription :: forall e. DocumentedFunction e -> Text -> DocumentedFunction e
updateFunctionDescription DocumentedFunction e
fn Text
desc =
let fnDoc :: FunctionDoc
fnDoc = forall e. DocumentedFunction e -> FunctionDoc
functionDoc DocumentedFunction e
fn
in DocumentedFunction e
fn { functionDoc :: FunctionDoc
functionDoc = FunctionDoc
fnDoc { functionDescription :: Text
functionDescription = Text
desc} }
setName :: Name -> DocumentedFunction e -> DocumentedFunction e
setName :: forall e. Name -> DocumentedFunction e -> DocumentedFunction e
setName Name
name DocumentedFunction e
fn = DocumentedFunction e
fn { functionName :: Name
functionName = Name
name }
since :: DocumentedFunction e -> Version -> DocumentedFunction e
since :: forall e. DocumentedFunction e -> Version -> DocumentedFunction e
since DocumentedFunction e
fn Version
version =
let fnDoc :: FunctionDoc
fnDoc = forall e. DocumentedFunction e -> FunctionDoc
functionDoc DocumentedFunction e
fn
in DocumentedFunction e
fn { functionDoc :: FunctionDoc
functionDoc = FunctionDoc
fnDoc { functionSince :: Maybe Version
functionSince = forall a. a -> Maybe a
Just Version
version }}
infixl 8 ###, <#>, =#>, =?>, #?, `since`
(###) :: (a -> HsFnPrecursor e a) -> a -> HsFnPrecursor e a
### :: forall a e. (a -> HsFnPrecursor e a) -> a -> HsFnPrecursor e a
(###) = forall a b. (a -> b) -> a -> 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
(<#>) = forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
applyParameter
(=#>) :: HsFnPrecursor e (LuaE e a)
-> FunctionResults e a
-> DocumentedFunction e
=#> :: forall e a.
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 NumResults)
-> Text
-> DocumentedFunction e
=?> :: forall e.
HsFnPrecursor e (LuaE e NumResults) -> Text -> DocumentedFunction e
(=?>) = forall e.
HsFnPrecursor e (LuaE e NumResults) -> Text -> DocumentedFunction e
returnResultsOnStack
(#?) :: DocumentedFunction e -> Text -> DocumentedFunction e
#? :: forall e. DocumentedFunction e -> Text -> DocumentedFunction e
(#?) = forall e. DocumentedFunction e -> Text -> DocumentedFunction e
updateFunctionDescription
pushDocumentedFunction :: LuaError e
=> DocumentedFunction e -> LuaE e ()
pushDocumentedFunction :: forall e. LuaError e => DocumentedFunction e -> LuaE e ()
pushDocumentedFunction DocumentedFunction e
fn = do
forall e. LuaError e => HaskellFunction e -> LuaE e ()
Lua.pushHaskellFunction forall a b. (a -> b) -> a -> b
$ forall e. DocumentedFunction e -> LuaE e NumResults
callFunction DocumentedFunction e
fn
forall e. LuaError e => DocumentedFunction e -> LuaE e ()
pushFunctionDoc DocumentedFunction e
fn
forall e. LuaError e => StackIndex -> LuaE e ()
registerDocumentation (CInt -> StackIndex
Lua.nth CInt
2)
parameter :: Peeker e a
-> TypeSpec
-> Text
-> Text
-> Parameter e a
parameter :: forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e a
peeker TypeSpec
type_ Text
name Text
desc = Parameter
{ parameterPeeker :: Peeker e a
parameterPeeker = Peeker e a
peeker
, parameterDoc :: ParameterDoc
parameterDoc = ParameterDoc
{ parameterName :: Text
parameterName = Text
name
, parameterDescription :: Text
parameterDescription = Text
desc
, parameterType :: TypeSpec
parameterType = TypeSpec
type_
, parameterIsOptional :: Bool
parameterIsOptional = Bool
False
}
}
opt :: Parameter e a -> Parameter e (Maybe a)
opt :: forall e a. Parameter e a -> Parameter e (Maybe a)
opt Parameter e a
p = Parameter
{ parameterPeeker :: Peeker e (Maybe a)
parameterPeeker = \StackIndex
idx ->
(forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e. Peeker e ()
peekNoneOrNil StackIndex
idx) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(forall a. a -> Maybe a
Just forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall e a. Parameter e a -> Peeker e a
parameterPeeker Parameter e a
p StackIndex
idx)
, parameterDoc :: ParameterDoc
parameterDoc = (forall e a. Parameter e a -> ParameterDoc
parameterDoc Parameter e a
p){ parameterIsOptional :: Bool
parameterIsOptional = Bool
True }
}
optionalParameter :: Peeker e a
-> TypeSpec
-> Text
-> Text
-> Parameter e (Maybe a)
optionalParameter :: forall e a.
Peeker e a -> TypeSpec -> Text -> Text -> Parameter e (Maybe a)
optionalParameter Peeker e a
peeker TypeSpec
type_ Text
name Text
desc = forall e a. Parameter e a -> Parameter e (Maybe a)
opt forall a b. (a -> b) -> a -> b
$
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e a
peeker TypeSpec
type_ Text
name Text
desc
{-# DEPRECATED optionalParameter "Use `opt (parameter ...)` instead." #-}
functionResult :: Pusher e a
-> TypeSpec
-> Text
-> FunctionResults e a
functionResult :: forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult Pusher e a
pusher TypeSpec
type_ Text
desc = (forall a. a -> [a] -> [a]
:[]) forall a b. (a -> b) -> a -> b
$ FunctionResult
{ fnResultPusher :: Pusher e a
fnResultPusher = Pusher e a
pusher
, fnResultDoc :: ResultValueDoc
fnResultDoc = ResultValueDoc
{ resultValueType :: TypeSpec
resultValueType = TypeSpec
type_
, resultValueDescription :: Text
resultValueDescription = Text
desc
}
}