{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-|
Module      : HsLua.Class.Exposable
Copyright   : © 2007–2012 Gracjan Polak,
                2012–2016 Ömer Sinan Ağacan,
                2017-2021 Albert Krewinkel
License     : MIT
Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de>
Stability   : beta
Portability : FlexibleInstances, ForeignFunctionInterface, ScopedTypeVariables

Call Haskell functions from Lua.
-}
module HsLua.Class.Exposable
  ( Exposable (..)
  , toHaskellFunction
  , registerHaskellFunction
  ) where

import HsLua.Core as Lua
import HsLua.Class.Peekable (Peekable (peek), PeekError (..), inContext)
import HsLua.Class.Pushable (Pushable (push))

-- | Operations and functions that can be pushed to the Lua stack. This
-- is a helper function not intended to be used directly. Use the
-- @'toHaskellFunction'@ wrapper instead.
class PeekError e => Exposable e a where
  -- | Helper function, called by @'toHaskellFunction'@. Should do a
  -- partial application of the argument at the given index to the
  -- underlying function. Recurses if necessary, causing further partial
  -- applications until the operation is a easily exposable to Lua.
  partialApply :: StackIndex -> a -> LuaE e NumResults

instance {-# OVERLAPPING #-} PeekError e =>
         Exposable e (HaskellFunction e) where
  partialApply :: StackIndex -> HaskellFunction e -> HaskellFunction e
partialApply StackIndex
_ = HaskellFunction e -> HaskellFunction e
forall a. a -> a
id

instance (PeekError e, Pushable a) => Exposable e (LuaE e a) where
  partialApply :: StackIndex -> LuaE e a -> LuaE e NumResults
partialApply StackIndex
_narg LuaE e a
x = NumResults
1 NumResults -> LuaE e () -> LuaE e NumResults
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (LuaE e a
x LuaE e a -> (a -> LuaE e ()) -> LuaE e ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> LuaE e ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push)

instance (Peekable a, Exposable e b) => Exposable e (a -> b) where
  partialApply :: StackIndex -> (a -> b) -> LuaE e NumResults
partialApply StackIndex
narg a -> b
f = LuaE e a
getArg LuaE e a -> (a -> LuaE e NumResults) -> LuaE e NumResults
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= StackIndex -> b -> LuaE e NumResults
forall e a. Exposable e a => StackIndex -> a -> LuaE e NumResults
partialApply (StackIndex
narg StackIndex -> StackIndex -> StackIndex
forall a. Num a => a -> a -> a
+ StackIndex
1) (b -> LuaE e NumResults) -> (a -> b) -> a -> LuaE e NumResults
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f
    where
      getArg :: LuaE e a
getArg = String -> LuaE e a -> LuaE e a
forall e a. PeekError e => String -> LuaE e a -> LuaE e a
inContext String
errorPrefix (StackIndex -> LuaE e a
forall a e. (Peekable a, PeekError e) => StackIndex -> LuaE e a
peek StackIndex
narg)
      errorPrefix :: String
errorPrefix = String
"could not read argument " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                    CInt -> String
forall a. Show a => a -> String
show (StackIndex -> CInt
fromStackIndex StackIndex
narg) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":"

-- | Convert a Haskell function to a function type directly exposable to
-- Lua. Any Haskell function can be converted provided that:
--
--   * all arguments are instances of @'Peekable'@
--   * return type is @Lua a@, where @a@ is an instance of
--     @'Pushable'@
--
-- Any @'Lua.Exception'@ will be converted to a string and returned
-- as Lua error.
--
-- /Important/: this does __not__ catch exceptions other than
-- @'Lua.Exception'@; exception handling must be done by the converted
-- Haskell function. Failure to do so will cause the program to crash.
--
-- E.g., the following code could be used to handle an Exception
-- of type FooException, if that type is an instance of
-- 'Control.Monad.Catch.MonadCatch' and 'Pushable':
--
-- > toHaskellFunction (myFun `catchM` (\e -> raiseError (e :: FooException)))
--
toHaskellFunction :: forall e a. Exposable e a => a -> HaskellFunction e
toHaskellFunction :: a -> HaskellFunction e
toHaskellFunction a
a = do
  String -> HaskellFunction e -> HaskellFunction e
forall e a. PeekError e => String -> LuaE e a -> LuaE e a
inContext String
"Error during function call:" (HaskellFunction e -> HaskellFunction e)
-> HaskellFunction e -> HaskellFunction e
forall a b. (a -> b) -> a -> b
$ StackIndex -> a -> HaskellFunction e
forall e a. Exposable e a => StackIndex -> a -> LuaE e NumResults
partialApply StackIndex
1 a
a

-- | Imports a Haskell function and registers it at global name.
registerHaskellFunction :: Exposable e a
                        => Name -> a -> LuaE e ()
registerHaskellFunction :: Name -> a -> LuaE e ()
registerHaskellFunction Name
n a
f = do
  HaskellFunction e -> LuaE e ()
forall e. LuaError e => HaskellFunction e -> LuaE e ()
pushHaskellFunction (HaskellFunction e -> LuaE e ()) -> HaskellFunction e -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ a -> HaskellFunction e
forall e a. Exposable e a => a -> HaskellFunction e
toHaskellFunction a
f
  Name -> LuaE e ()
forall e. LuaError e => Name -> LuaE e ()
setglobal Name
n