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

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

    import Data.String (fromString)
    import HsLua.Core as Lua
    import HsLua.Marshalling (Peek, forcePeek, liftLua, retrieving, withContext)
    import HsLua.Class.Peekable (Peekable (safepeek))
    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 LuaError 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 -> Peek e NumResults

    instance {-# OVERLAPPING #-} LuaError e =>
             Exposable e (HaskellFunction e) where
      partialApply :: StackIndex -> HaskellFunction e -> Peek e NumResults
    partialApply StackIndex
    _ = HaskellFunction e -> Peek e NumResults
    forall e a. LuaE e a -> Peek e a
    liftLua

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

    instance (LuaError e, Pushable a) => Exposable e (Peek e a) where
      partialApply :: StackIndex -> Peek e a -> Peek e NumResults
    partialApply StackIndex
    _narg Peek e a
    x = NumResults
    1 NumResults -> Peek e () -> Peek e NumResults
    forall a b. a -> Peek e b -> Peek e a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ (Peek e a
    x Peek e a -> (a -> Peek e ()) -> Peek e ()
    forall a b. Peek e a -> (a -> Peek e b) -> Peek e b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= LuaE e () -> Peek e ()
    forall e a. LuaE e a -> Peek e a
    liftLua (LuaE e () -> Peek e ()) -> (a -> LuaE e ()) -> a -> Peek e ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> LuaE e ()
    forall e. LuaError e => 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) -> Peek e NumResults
    partialApply StackIndex
    narg a -> b
    f = Peek e a
    getArg Peek e a -> (a -> Peek e NumResults) -> Peek e NumResults
    forall a b. Peek e a -> (a -> Peek e b) -> Peek e b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= StackIndex -> b -> Peek e NumResults
    forall e a. Exposable e a => StackIndex -> a -> Peek e NumResults
    partialApply (StackIndex
    narg StackIndex -> StackIndex -> StackIndex
    forall a. Num a => a -> a -> a
    + StackIndex
    1) (b -> Peek e NumResults) -> (a -> b) -> a -> Peek e NumResults
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> b
    f
        where
          getArg :: Peek e a
    getArg = Name -> Peek e a -> Peek e a
    forall e a. Name -> Peek e a -> Peek e a
    retrieving (String -> Name
    forall a. IsString a => String -> a
    fromString String
    errorPrefix) (Peeker e a
    forall e. LuaError e => Peeker e a
    forall a e. (Peekable a, LuaError e) => Peeker e a
    safepeek StackIndex
    narg)
          errorPrefix :: String
    errorPrefix = String
    "argument " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ CInt -> String
    forall a. Show a => a -> String
    show (StackIndex -> CInt
    fromStackIndex StackIndex
    narg)

    -- | 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 @LuaE e a@, where @a@ is an instance of
    --     @'Pushable'@
    --
    -- Any exception of type @e@ will be caught.
    --
    -- /Important/: this does __not__ catch exceptions other than @e@;
    -- exception handling must be done by the 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 :: forall e a. Exposable e a => a -> HaskellFunction e
    toHaskellFunction a
    a = Peek e NumResults -> LuaE e NumResults
    forall e a. LuaError e => Peek e a -> LuaE e a
    forcePeek (Peek e NumResults -> LuaE e NumResults)
    -> Peek e NumResults -> LuaE e NumResults
    forall a b. (a -> b) -> a -> b
    $ do
      Name -> Peek e NumResults -> Peek e NumResults
    forall e a. Name -> Peek e a -> Peek e a
    withContext Name
    "executing function call" (Peek e NumResults -> Peek e NumResults)
    -> Peek e NumResults -> Peek e NumResults
    forall a b. (a -> b) -> a -> b
    $ StackIndex -> a -> Peek e NumResults
    forall e a. Exposable e a => StackIndex -> a -> Peek e NumResults
    partialApply StackIndex
    1 a
    a

    -- | Pushes the given value as a function to the Lua stack.
    --
    -- See 'toHaskellFunction' for details.
    pushAsHaskellFunction :: forall e a. Exposable e a => a -> LuaE e ()
    pushAsHaskellFunction :: forall e a. Exposable e a => a -> LuaE e ()
    pushAsHaskellFunction = HaskellFunction e -> LuaE e ()
    forall e. LuaError e => HaskellFunction e -> LuaE e ()
    pushHaskellFunction (HaskellFunction e -> LuaE e ())
    -> (a -> HaskellFunction e) -> a -> LuaE e ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> HaskellFunction e
    forall e a. Exposable e a => a -> HaskellFunction e
    toHaskellFunction

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