{-# LANGUAGE ScopedTypeVariables #-}
{-|
Module      : HsLua.Class.Util
Copyright   : © 2007–2012 Gracjan Polak;
              © 2012–2016 Ömer Sinan Ağacan;
              © 2017-2022 Albert Krewinkel
License     : MIT
Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de>
Stability   : beta
Portability : non-portable (depends on GHC)

HsLua utility functions.
-}
module HsLua.Class.Util
  ( raiseError
  , Optional (Optional, fromOptional)
    -- * getting values
  , peekEither
  , popValue
  ) where

import Control.Applicative ((<|>))
import HsLua.Core (LuaE, LuaError, NumResults, StackIndex, top)
import HsLua.Class.Peekable (Peekable (safepeek), peek)
import HsLua.Class.Pushable (Pushable (push))

import qualified HsLua.Core as Lua
import qualified HsLua.Marshalling as Lua

-- | Raise a Lua error, using the given value as the error object.
raiseError :: (LuaError e, Pushable a) => a -> LuaE e NumResults
raiseError :: a -> LuaE e NumResults
raiseError a
e = do
  a -> LuaE e ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push a
e
  LuaE e NumResults
forall e. LuaE e NumResults
Lua.error
{-# INLINABLE raiseError #-}

-- | Newtype wrapper intended to be used for optional Lua values. Nesting this
-- type is strongly discouraged as missing values on inner levels are
-- indistinguishable from missing values on an outer level; wrong values
-- would be the likely result.
newtype Optional a = Optional { Optional a -> Maybe a
fromOptional :: Maybe a }

instance Peekable a => Peekable (Optional a) where
  safepeek :: Peeker e (Optional a)
safepeek StackIndex
idx = (Maybe a -> Optional a
forall a. Maybe a -> Optional a
Optional Maybe a
forall a. Maybe a
Nothing Optional a -> Peek e () -> Peek e (Optional a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Peeker e ()
forall e. Peeker e ()
Lua.peekNoneOrNil StackIndex
idx)
             Peek e (Optional a) -> Peek e (Optional a) -> Peek e (Optional a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Maybe a -> Optional a
forall a. Maybe a -> Optional a
Optional (Maybe a -> Optional a) -> (a -> Maybe a) -> a -> Optional a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just (a -> Optional a) -> Peek e a -> Peek e (Optional a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Peeker e a
forall a e. (Peekable a, LuaError e) => Peeker e a
safepeek StackIndex
idx)

instance Pushable a => Pushable (Optional a) where
  push :: Optional a -> LuaE e ()
push (Optional Maybe a
Nothing)  = LuaE e ()
forall e. LuaE e ()
Lua.pushnil
  push (Optional (Just a
x)) = a -> LuaE e ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push a
x


--
-- Getting Values
--

-- | Try to convert the value at the given stack index to a Haskell value.
-- Returns 'Left' with the error on failure.
peekEither :: (LuaError e, Peekable a)
           => StackIndex -> LuaE e (Either e a)
peekEither :: StackIndex -> LuaE e (Either e a)
peekEither = LuaE e a -> LuaE e (Either e a)
forall e a. Exception e => LuaE e a -> LuaE e (Either e a)
Lua.try (LuaE e a -> LuaE e (Either e a))
-> (StackIndex -> LuaE e a) -> StackIndex -> LuaE e (Either e a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> LuaE e a
forall a e. (LuaError e, Peekable a) => StackIndex -> LuaE e a
peek

-- | Get, then pop the value at the top of the stack. The pop operation is
-- executed even if the retrieval operation failed.
popValue :: (LuaError e, Peekable a) => LuaE e a
popValue :: LuaE e a
popValue = Peek e a -> LuaE e a
forall e a. LuaError e => Peek e a -> LuaE e a
Lua.forcePeek (Peek e a -> LuaE e a) -> Peek e a -> LuaE e a
forall a b. (a -> b) -> a -> b
$ Peeker e a
forall a e. (Peekable a, LuaError e) => Peeker e a
safepeek StackIndex
top Peek e a -> LuaE e () -> Peek e a
forall e a b. Peek e a -> LuaE e b -> Peek e a
`Lua.lastly` Int -> LuaE e ()
forall e. Int -> LuaE e ()
Lua.pop Int
1
{-# INLINABLE popValue #-}