{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-|
Module      : Foreign.Lua.Call
Copyright   : © 2020 Albert Krewinkel
License     : MIT
Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de>
Stability   : alpha
Portability : Portable

Marshaling and documenting Haskell functions.
-}
module Foreign.Lua.Call
  ( HaskellFunction (..)
  , toHsFnPrecursor
  , toHsFnPrecursorWithStartIndex
  , applyParameter
  , returnResult
  , Parameter (..)
  , FunctionResult (..)
  , FunctionResults
    -- * Operators
  , (<#>)
  , (=#>)
  , (#?)
    -- * Documentation
  , FunctionDoc (..)
  , ParameterDoc (..)
  , FunctionResultDoc (..)
  , render
    -- * Pushing to Lua
  , pushHaskellFunction
    -- * Convenience functions
  , parameter
  , optionalParameter
  , functionResult
  ) where

import Control.Monad.Except
import Data.Text (Text)
import Foreign.Lua.Core as Lua
import Foreign.Lua.Core.Types (liftLua)
import Foreign.Lua.Peek
import Foreign.Lua.Push
import Foreign.Lua.Raw.Call (hslua_pushhsfunction)
import qualified Data.Text as T

-- | Lua operation with an explicit error type and state (i.e.,
-- without exceptions).
type LuaExcept a = ExceptT PeekError Lua a


--
-- Function components
--

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

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

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

-- | Haskell equivallent to CFunction, i.e., function callable
-- from Lua.
data HaskellFunction = HaskellFunction
  { HaskellFunction -> Lua NumResults
callFunction :: Lua NumResults
  , HaskellFunction -> Maybe FunctionDoc
functionDoc :: Maybe FunctionDoc
  }

--
-- Documentation
--

-- | Documentation for a Haskell function
data FunctionDoc = FunctionDoc
  { FunctionDoc -> Text
functionDescription :: Text
  , FunctionDoc -> [ParameterDoc]
parameterDocs       :: [ParameterDoc]
  , FunctionDoc -> [FunctionResultDoc]
functionResultDocs  :: [FunctionResultDoc]
  }
  deriving (FunctionDoc -> FunctionDoc -> Bool
(FunctionDoc -> FunctionDoc -> Bool)
-> (FunctionDoc -> FunctionDoc -> Bool) -> Eq FunctionDoc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FunctionDoc -> FunctionDoc -> Bool
$c/= :: FunctionDoc -> FunctionDoc -> Bool
== :: FunctionDoc -> FunctionDoc -> Bool
$c== :: FunctionDoc -> FunctionDoc -> Bool
Eq, Eq FunctionDoc
Eq FunctionDoc
-> (FunctionDoc -> FunctionDoc -> Ordering)
-> (FunctionDoc -> FunctionDoc -> Bool)
-> (FunctionDoc -> FunctionDoc -> Bool)
-> (FunctionDoc -> FunctionDoc -> Bool)
-> (FunctionDoc -> FunctionDoc -> Bool)
-> (FunctionDoc -> FunctionDoc -> FunctionDoc)
-> (FunctionDoc -> FunctionDoc -> FunctionDoc)
-> Ord FunctionDoc
FunctionDoc -> FunctionDoc -> Bool
FunctionDoc -> FunctionDoc -> Ordering
FunctionDoc -> FunctionDoc -> FunctionDoc
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FunctionDoc -> FunctionDoc -> FunctionDoc
$cmin :: FunctionDoc -> FunctionDoc -> FunctionDoc
max :: FunctionDoc -> FunctionDoc -> FunctionDoc
$cmax :: FunctionDoc -> FunctionDoc -> FunctionDoc
>= :: FunctionDoc -> FunctionDoc -> Bool
$c>= :: FunctionDoc -> FunctionDoc -> Bool
> :: FunctionDoc -> FunctionDoc -> Bool
$c> :: FunctionDoc -> FunctionDoc -> Bool
<= :: FunctionDoc -> FunctionDoc -> Bool
$c<= :: FunctionDoc -> FunctionDoc -> Bool
< :: FunctionDoc -> FunctionDoc -> Bool
$c< :: FunctionDoc -> FunctionDoc -> Bool
compare :: FunctionDoc -> FunctionDoc -> Ordering
$ccompare :: FunctionDoc -> FunctionDoc -> Ordering
$cp1Ord :: Eq FunctionDoc
Ord, Int -> FunctionDoc -> ShowS
[FunctionDoc] -> ShowS
FunctionDoc -> String
(Int -> FunctionDoc -> ShowS)
-> (FunctionDoc -> String)
-> ([FunctionDoc] -> ShowS)
-> Show FunctionDoc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FunctionDoc] -> ShowS
$cshowList :: [FunctionDoc] -> ShowS
show :: FunctionDoc -> String
$cshow :: FunctionDoc -> String
showsPrec :: Int -> FunctionDoc -> ShowS
$cshowsPrec :: Int -> FunctionDoc -> ShowS
Show)

-- | Documentation for function parameters.
data ParameterDoc = ParameterDoc
  { ParameterDoc -> Text
parameterName :: Text
  , ParameterDoc -> Text
parameterType :: Text
  , ParameterDoc -> Text
parameterDescription :: Text
  , ParameterDoc -> Bool
parameterIsOptional :: Bool
  }
  deriving (ParameterDoc -> ParameterDoc -> Bool
(ParameterDoc -> ParameterDoc -> Bool)
-> (ParameterDoc -> ParameterDoc -> Bool) -> Eq ParameterDoc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParameterDoc -> ParameterDoc -> Bool
$c/= :: ParameterDoc -> ParameterDoc -> Bool
== :: ParameterDoc -> ParameterDoc -> Bool
$c== :: ParameterDoc -> ParameterDoc -> Bool
Eq, Eq ParameterDoc
Eq ParameterDoc
-> (ParameterDoc -> ParameterDoc -> Ordering)
-> (ParameterDoc -> ParameterDoc -> Bool)
-> (ParameterDoc -> ParameterDoc -> Bool)
-> (ParameterDoc -> ParameterDoc -> Bool)
-> (ParameterDoc -> ParameterDoc -> Bool)
-> (ParameterDoc -> ParameterDoc -> ParameterDoc)
-> (ParameterDoc -> ParameterDoc -> ParameterDoc)
-> Ord ParameterDoc
ParameterDoc -> ParameterDoc -> Bool
ParameterDoc -> ParameterDoc -> Ordering
ParameterDoc -> ParameterDoc -> ParameterDoc
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ParameterDoc -> ParameterDoc -> ParameterDoc
$cmin :: ParameterDoc -> ParameterDoc -> ParameterDoc
max :: ParameterDoc -> ParameterDoc -> ParameterDoc
$cmax :: ParameterDoc -> ParameterDoc -> ParameterDoc
>= :: ParameterDoc -> ParameterDoc -> Bool
$c>= :: ParameterDoc -> ParameterDoc -> Bool
> :: ParameterDoc -> ParameterDoc -> Bool
$c> :: ParameterDoc -> ParameterDoc -> Bool
<= :: ParameterDoc -> ParameterDoc -> Bool
$c<= :: ParameterDoc -> ParameterDoc -> Bool
< :: ParameterDoc -> ParameterDoc -> Bool
$c< :: ParameterDoc -> ParameterDoc -> Bool
compare :: ParameterDoc -> ParameterDoc -> Ordering
$ccompare :: ParameterDoc -> ParameterDoc -> Ordering
$cp1Ord :: Eq ParameterDoc
Ord, Int -> ParameterDoc -> ShowS
[ParameterDoc] -> ShowS
ParameterDoc -> String
(Int -> ParameterDoc -> ShowS)
-> (ParameterDoc -> String)
-> ([ParameterDoc] -> ShowS)
-> Show ParameterDoc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParameterDoc] -> ShowS
$cshowList :: [ParameterDoc] -> ShowS
show :: ParameterDoc -> String
$cshow :: ParameterDoc -> String
showsPrec :: Int -> ParameterDoc -> ShowS
$cshowsPrec :: Int -> ParameterDoc -> ShowS
Show)

-- | Documentation for the result of a function.
data FunctionResultDoc = FunctionResultDoc
  { FunctionResultDoc -> Text
functionResultType :: Text
  , FunctionResultDoc -> Text
functionResultDescription :: Text
  }
  deriving (FunctionResultDoc -> FunctionResultDoc -> Bool
(FunctionResultDoc -> FunctionResultDoc -> Bool)
-> (FunctionResultDoc -> FunctionResultDoc -> Bool)
-> Eq FunctionResultDoc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FunctionResultDoc -> FunctionResultDoc -> Bool
$c/= :: FunctionResultDoc -> FunctionResultDoc -> Bool
== :: FunctionResultDoc -> FunctionResultDoc -> Bool
$c== :: FunctionResultDoc -> FunctionResultDoc -> Bool
Eq, Eq FunctionResultDoc
Eq FunctionResultDoc
-> (FunctionResultDoc -> FunctionResultDoc -> Ordering)
-> (FunctionResultDoc -> FunctionResultDoc -> Bool)
-> (FunctionResultDoc -> FunctionResultDoc -> Bool)
-> (FunctionResultDoc -> FunctionResultDoc -> Bool)
-> (FunctionResultDoc -> FunctionResultDoc -> Bool)
-> (FunctionResultDoc -> FunctionResultDoc -> FunctionResultDoc)
-> (FunctionResultDoc -> FunctionResultDoc -> FunctionResultDoc)
-> Ord FunctionResultDoc
FunctionResultDoc -> FunctionResultDoc -> Bool
FunctionResultDoc -> FunctionResultDoc -> Ordering
FunctionResultDoc -> FunctionResultDoc -> FunctionResultDoc
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FunctionResultDoc -> FunctionResultDoc -> FunctionResultDoc
$cmin :: FunctionResultDoc -> FunctionResultDoc -> FunctionResultDoc
max :: FunctionResultDoc -> FunctionResultDoc -> FunctionResultDoc
$cmax :: FunctionResultDoc -> FunctionResultDoc -> FunctionResultDoc
>= :: FunctionResultDoc -> FunctionResultDoc -> Bool
$c>= :: FunctionResultDoc -> FunctionResultDoc -> Bool
> :: FunctionResultDoc -> FunctionResultDoc -> Bool
$c> :: FunctionResultDoc -> FunctionResultDoc -> Bool
<= :: FunctionResultDoc -> FunctionResultDoc -> Bool
$c<= :: FunctionResultDoc -> FunctionResultDoc -> Bool
< :: FunctionResultDoc -> FunctionResultDoc -> Bool
$c< :: FunctionResultDoc -> FunctionResultDoc -> Bool
compare :: FunctionResultDoc -> FunctionResultDoc -> Ordering
$ccompare :: FunctionResultDoc -> FunctionResultDoc -> Ordering
$cp1Ord :: Eq FunctionResultDoc
Ord, Int -> FunctionResultDoc -> ShowS
[FunctionResultDoc] -> ShowS
FunctionResultDoc -> String
(Int -> FunctionResultDoc -> ShowS)
-> (FunctionResultDoc -> String)
-> ([FunctionResultDoc] -> ShowS)
-> Show FunctionResultDoc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FunctionResultDoc] -> ShowS
$cshowList :: [FunctionResultDoc] -> ShowS
show :: FunctionResultDoc -> String
$cshow :: FunctionResultDoc -> String
showsPrec :: Int -> FunctionResultDoc -> ShowS
$cshowsPrec :: Int -> FunctionResultDoc -> ShowS
Show)


--
-- Haskell function building
--

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

-- | Create a HaskellFunction precursor from a pure function.
toHsFnPrecursor :: a -> HsFnPrecursor a
toHsFnPrecursor :: a -> HsFnPrecursor a
toHsFnPrecursor = StackIndex -> a -> HsFnPrecursor a
forall a. StackIndex -> a -> HsFnPrecursor a
toHsFnPrecursorWithStartIndex (CInt -> StackIndex
StackIndex CInt
0)

toHsFnPrecursorWithStartIndex :: StackIndex -> a -> HsFnPrecursor a
toHsFnPrecursorWithStartIndex :: StackIndex -> a -> HsFnPrecursor a
toHsFnPrecursorWithStartIndex StackIndex
idx a
f = HsFnPrecursor :: forall a.
LuaExcept a -> StackIndex -> [ParameterDoc] -> HsFnPrecursor a
HsFnPrecursor
  { hsFnPrecursorAction :: LuaExcept a
hsFnPrecursorAction = a -> LuaExcept 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
  }

-- | Partially apply a parameter.
applyParameter :: HsFnPrecursor (a -> b)
               -> Parameter a
               -> HsFnPrecursor b
applyParameter :: HsFnPrecursor (a -> b) -> Parameter a -> HsFnPrecursor b
applyParameter HsFnPrecursor (a -> b)
bldr Parameter a
param = do
  let action :: LuaExcept (a -> b)
action = HsFnPrecursor (a -> b) -> LuaExcept (a -> b)
forall a. HsFnPrecursor a -> LuaExcept a
hsFnPrecursorAction HsFnPrecursor (a -> b)
bldr
  let i :: StackIndex
i = HsFnPrecursor (a -> b) -> StackIndex
forall a. HsFnPrecursor a -> StackIndex
hsFnMaxParameterIdx HsFnPrecursor (a -> b)
bldr StackIndex -> StackIndex -> StackIndex
forall a. Num a => a -> a -> a
+ StackIndex
1
  let context :: Text
context = Text
"retrieving function argument " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        (ParameterDoc -> Text
parameterName (ParameterDoc -> Text)
-> (Parameter a -> ParameterDoc) -> Parameter a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parameter a -> ParameterDoc
forall a. Parameter a -> ParameterDoc
parameterDoc) Parameter a
param
  let nextAction :: (a -> a) -> ExceptT PeekError Lua a
nextAction a -> a
f = (PeekError -> PeekError)
-> ExceptT PeekError Lua a -> ExceptT PeekError Lua a
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT (Text -> PeekError -> PeekError
pushMsg Text
context) (ExceptT PeekError Lua a -> ExceptT PeekError Lua a)
-> ExceptT PeekError Lua a -> ExceptT PeekError Lua a
forall a b. (a -> b) -> a -> b
$ do
        a
x <- Lua (Either PeekError a) -> ExceptT PeekError Lua a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (Lua (Either PeekError a) -> ExceptT PeekError Lua a)
-> Lua (Either PeekError a) -> ExceptT PeekError Lua a
forall a b. (a -> b) -> a -> b
$ Parameter a -> Peeker a
forall a. Parameter a -> Peeker a
parameterPeeker Parameter a
param StackIndex
i
        a -> ExceptT PeekError Lua a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> ExceptT PeekError Lua a) -> a -> ExceptT PeekError Lua a
forall a b. (a -> b) -> a -> b
$ a -> a
f a
x
  HsFnPrecursor :: forall a.
LuaExcept a -> StackIndex -> [ParameterDoc] -> HsFnPrecursor a
HsFnPrecursor
    { hsFnPrecursorAction :: LuaExcept b
hsFnPrecursorAction = LuaExcept (a -> b)
action LuaExcept (a -> b) -> ((a -> b) -> LuaExcept b) -> LuaExcept b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (a -> b) -> LuaExcept b
forall a. (a -> a) -> ExceptT PeekError Lua a
nextAction
    , hsFnMaxParameterIdx :: StackIndex
hsFnMaxParameterIdx = StackIndex
i
    , hsFnParameterDocs :: [ParameterDoc]
hsFnParameterDocs = Parameter a -> ParameterDoc
forall a. Parameter a -> ParameterDoc
parameterDoc Parameter a
param ParameterDoc -> [ParameterDoc] -> [ParameterDoc]
forall a. a -> [a] -> [a]
: HsFnPrecursor (a -> b) -> [ParameterDoc]
forall a. HsFnPrecursor a -> [ParameterDoc]
hsFnParameterDocs HsFnPrecursor (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 a
              -> FunctionResults a
              -> HaskellFunction
returnResults :: HsFnPrecursor a -> FunctionResults a -> HaskellFunction
returnResults HsFnPrecursor a
bldr FunctionResults a
fnResults = HaskellFunction :: Lua NumResults -> Maybe FunctionDoc -> HaskellFunction
HaskellFunction
  { callFunction :: Lua NumResults
callFunction = do
      Either PeekError a
hsResult <- ExceptT PeekError Lua a -> Lua (Either PeekError a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT PeekError Lua a -> Lua (Either PeekError a))
-> ExceptT PeekError Lua a -> Lua (Either PeekError a)
forall a b. (a -> b) -> a -> b
$ HsFnPrecursor a -> ExceptT PeekError Lua a
forall a. HsFnPrecursor a -> LuaExcept a
hsFnPrecursorAction HsFnPrecursor a
bldr
      case Either PeekError a
hsResult of
        Left PeekError
err -> do
          String -> Lua ()
pushString (String -> Lua ()) -> String -> Lua ()
forall a b. (a -> b) -> a -> b
$ PeekError -> String
formatPeekError PeekError
err
          Lua NumResults
Lua.error
        Right a
x -> do
          FunctionResults a -> (FunctionResult a -> Lua ()) -> Lua ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ FunctionResults a
fnResults ((FunctionResult a -> Lua ()) -> Lua ())
-> (FunctionResult a -> Lua ()) -> Lua ()
forall a b. (a -> b) -> a -> b
$ \(FunctionResult Pusher a
push FunctionResultDoc
_) -> Pusher a
push a
x
          NumResults -> Lua NumResults
forall (m :: * -> *) a. Monad m => a -> m a
return (NumResults -> Lua NumResults) -> NumResults -> Lua 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 a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FunctionResults a
fnResults)

  , functionDoc :: Maybe FunctionDoc
functionDoc = FunctionDoc -> Maybe FunctionDoc
forall a. a -> Maybe a
Just (FunctionDoc -> Maybe FunctionDoc)
-> FunctionDoc -> Maybe FunctionDoc
forall a b. (a -> b) -> a -> b
$ FunctionDoc :: Text -> [ParameterDoc] -> [FunctionResultDoc] -> 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 a -> [ParameterDoc]
forall a. HsFnPrecursor a -> [ParameterDoc]
hsFnParameterDocs HsFnPrecursor a
bldr
    , functionResultDocs :: [FunctionResultDoc]
functionResultDocs = (FunctionResult a -> FunctionResultDoc)
-> FunctionResults a -> [FunctionResultDoc]
forall a b. (a -> b) -> [a] -> [b]
map FunctionResult a -> FunctionResultDoc
forall a. FunctionResult a -> FunctionResultDoc
fnResultDoc FunctionResults a
fnResults
    }
  }

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

-- | Updates the description of a Haskell function. Leaves the function
-- unchanged if it has no documentation.
updateFunctionDescription :: HaskellFunction -> Text -> HaskellFunction
updateFunctionDescription :: HaskellFunction -> Text -> HaskellFunction
updateFunctionDescription HaskellFunction
fn Text
desc =
  case HaskellFunction -> Maybe FunctionDoc
functionDoc HaskellFunction
fn of
    Maybe FunctionDoc
Nothing -> HaskellFunction
fn
    Just FunctionDoc
fnDoc ->
      HaskellFunction
fn { functionDoc :: Maybe FunctionDoc
functionDoc = FunctionDoc -> Maybe FunctionDoc
forall a. a -> Maybe a
Just (FunctionDoc -> Maybe FunctionDoc)
-> FunctionDoc -> Maybe FunctionDoc
forall a b. (a -> b) -> a -> b
$ FunctionDoc
fnDoc { functionDescription :: Text
functionDescription = Text
desc} }

--
-- Operators
--

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

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

-- | Inline version of @'returnResult'@.
(=#>) :: HsFnPrecursor a
      -> FunctionResults a
      -> HaskellFunction
=#> :: HsFnPrecursor a -> FunctionResults a -> HaskellFunction
(=#>) = HsFnPrecursor a -> FunctionResults a -> HaskellFunction
forall a. HsFnPrecursor a -> FunctionResults a -> HaskellFunction
returnResults

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

--
-- Render documentation
--

render :: FunctionDoc -> Text
render :: FunctionDoc -> Text
render (FunctionDoc Text
desc [ParameterDoc]
paramDocs [FunctionResultDoc]
resultDoc) =
  (if Text -> Bool
T.null Text
desc then Text
"" else Text
desc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\n") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
  [ParameterDoc] -> Text
renderParamDocs [ParameterDoc]
paramDocs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
  case [FunctionResultDoc]
resultDoc of
    [] -> Text
""
    [FunctionResultDoc]
rd -> Text
"\nReturns:\n\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
"\n" ((FunctionResultDoc -> Text) -> [FunctionResultDoc] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map FunctionResultDoc -> Text
renderResultDoc [FunctionResultDoc]
rd)

renderParamDocs :: [ParameterDoc] -> Text
renderParamDocs :: [ParameterDoc] -> Text
renderParamDocs [ParameterDoc]
pds = Text
"Parameters:\n\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
  Text -> [Text] -> Text
T.intercalate Text
"\n" ((ParameterDoc -> Text) -> [ParameterDoc] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ParameterDoc -> Text
renderParamDoc [ParameterDoc]
pds)

renderParamDoc :: ParameterDoc -> Text
renderParamDoc :: ParameterDoc -> Text
renderParamDoc ParameterDoc
pd = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
  [ ParameterDoc -> Text
parameterName ParameterDoc
pd
  ,  Text
"\n:   "
  , ParameterDoc -> Text
parameterDescription ParameterDoc
pd
  , Text
" (", ParameterDoc -> Text
parameterType ParameterDoc
pd, Text
")\n"
  ]

renderResultDoc :: FunctionResultDoc -> Text
renderResultDoc :: FunctionResultDoc -> Text
renderResultDoc FunctionResultDoc
rd = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
  [ Text
" - "
  , FunctionResultDoc -> Text
functionResultDescription FunctionResultDoc
rd
  , Text
" (", FunctionResultDoc -> Text
functionResultType FunctionResultDoc
rd, Text
")\n"
  ]

--
-- Push to Lua
--

pushHaskellFunction :: HaskellFunction -> Lua ()
pushHaskellFunction :: HaskellFunction -> Lua ()
pushHaskellFunction HaskellFunction
fn = do
  ErrorConversion
errConv <- Lua ErrorConversion
Lua.errorConversion
  let hsFn :: State -> IO NumResults
hsFn = (State -> Lua NumResults -> IO NumResults)
-> Lua NumResults -> State -> IO NumResults
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ErrorConversion -> State -> Lua NumResults -> IO NumResults
forall a. ErrorConversion -> State -> Lua a -> IO a
runWithConverter ErrorConversion
errConv) (Lua NumResults -> State -> IO NumResults)
-> Lua NumResults -> State -> IO NumResults
forall a b. (a -> b) -> a -> b
$ HaskellFunction -> Lua NumResults
callFunction HaskellFunction
fn
  (State -> IO ()) -> Lua ()
forall a. (State -> IO a) -> Lua a
liftLua ((State -> IO ()) -> Lua ()) -> (State -> IO ()) -> Lua ()
forall a b. (a -> b) -> a -> b
$ \State
l -> State -> (State -> IO NumResults) -> IO ()
hslua_pushhsfunction State
l State -> IO NumResults
hsFn

--
-- Convenience functions
--

-- | Creates a parameter.
parameter :: Peeker a     -- ^ method to retrieve value from Lua
          -> Text         -- ^ expected Lua type
          -> Text         -- ^ parameter name
          -> Text         -- ^ parameter description
          -> Parameter a
parameter :: Peeker a -> Text -> Text -> Text -> Parameter a
parameter Peeker a
peeker Text
type_ Text
name Text
desc = Parameter :: forall a. Peeker a -> ParameterDoc -> Parameter a
Parameter
  { parameterPeeker :: Peeker a
parameterPeeker = Peeker 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 a     -- ^ method to retrieve the value from Lua
                  -> Text         -- ^ expected Lua type
                  -> Text         -- ^ parameter name
                  -> Text         -- ^ parameter description
                  -> Parameter (Maybe a)
optionalParameter :: Peeker a -> Text -> Text -> Text -> Parameter (Maybe a)
optionalParameter Peeker a
peeker Text
type_ Text
name Text
desc = Parameter :: forall a. Peeker a -> ParameterDoc -> Parameter a
Parameter
  { parameterPeeker :: Peeker (Maybe a)
parameterPeeker = Peeker a -> Peeker (Maybe a)
forall a. Peeker a -> Peeker (Maybe a)
optional Peeker 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
True
    }
  }

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