{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RankNTypes                 #-}
{-|
Module      : Foreign.Lua.Core.Types
Copyright   : © 2007–2012 Gracjan Polak,
                2012–2016 Ömer Sinan Ağacan,
                2017-2020 Albert Krewinkel
License     : MIT
Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de>
Stability   : beta
Portability : non-portable (depends on GHC)

The core Lua types, including mappings of Lua types to Haskell.

This module has mostly been moved to @'Foreign.Lua.Raw.Types'@ and
currently re-exports that module. This module might be removed in
the future.
-}
module Foreign.Lua.Core.Types
  ( Lua (..)
  , LuaEnvironment (..)
  , ErrorConversion (..)
  , errorConversion
  , State (..)
  , Reader
  , liftLua
  , liftLua1
  , state
  , runWithConverter
  , unsafeRunWith
  , unsafeErrorConversion
  , GCCONTROL (..)
  , Type (..)
  , TypeCode (..)
  , fromType
  , toType
  , liftIO
  , CFunction
  , LuaBool (..)
  , false
  , true
  , fromLuaBool
  , toLuaBool
  , Integer (..)
  , Number (..)
  , StackIndex (..)
  , nth
  , nthFromBottom
  , nthFromTop
  , stackTop
  , stackBottom
  , top
  , NumArgs (..)
  , NumResults (..)
  , RelationalOperator (..)
  , fromRelationalOperator
  , Status (..)
  , StatusCode (..)
  , toStatus
    -- * References
  , Reference (..)
  , fromReference
  , toReference
  ) where

import Prelude hiding (Integer)

import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow)
import Control.Monad.Reader (ReaderT (..), MonadReader, MonadIO, asks, liftIO)
import Foreign.C (CInt)
import Foreign.Lua.Raw.Types
import Foreign.Lua.Raw.Auxiliary
  ( Reference (..)
  , fromReference
  , toReference
  )

-- | Define the ways in which exceptions and errors are handled.
data ErrorConversion = ErrorConversion
  { ErrorConversion -> forall a. State -> IO a
errorToException :: forall a . State -> IO a
    -- ^ Translate Lua errors to Haskell exceptions
  , ErrorConversion -> forall a. String -> Lua a -> Lua a
addContextToException :: forall a . String -> Lua a -> Lua a
    -- ^ Add information on the current context to an exception.
  , ErrorConversion -> forall a. Lua a -> Lua a -> Lua a
alternative :: forall a . Lua a -> Lua a -> Lua a
    -- ^ Runs the second computation only if the first fails; returns
    -- the result of the first successful computation, if any.
  , ErrorConversion -> Lua NumResults -> Lua NumResults
exceptionToError :: Lua NumResults -> Lua NumResults
    -- ^ Translate Haskell exceptions to Lua errors
  }

-- | Environment in which Lua computations are evaluated.
data LuaEnvironment = LuaEnvironment
  { LuaEnvironment -> ErrorConversion
luaEnvErrorConversion :: ErrorConversion
    -- ^ Functions for error and exception handling and conversion
  , LuaEnvironment -> State
luaEnvState :: State
    -- ^ Lua interpreter state
  }

-- | A Lua computation. This is the base type used to run Lua programs of any
-- kind. The Lua state is handled automatically, but can be retrieved via
-- @'state'@.
newtype Lua a = Lua { Lua a -> ReaderT LuaEnvironment IO a
unLua :: ReaderT LuaEnvironment IO a }
  deriving
    ( Functor Lua
a -> Lua a
Functor Lua
-> (forall a. a -> Lua a)
-> (forall a b. Lua (a -> b) -> Lua a -> Lua b)
-> (forall a b c. (a -> b -> c) -> Lua a -> Lua b -> Lua c)
-> (forall a b. Lua a -> Lua b -> Lua b)
-> (forall a b. Lua a -> Lua b -> Lua a)
-> Applicative Lua
Lua a -> Lua b -> Lua b
Lua a -> Lua b -> Lua a
Lua (a -> b) -> Lua a -> Lua b
(a -> b -> c) -> Lua a -> Lua b -> Lua c
forall a. a -> Lua a
forall a b. Lua a -> Lua b -> Lua a
forall a b. Lua a -> Lua b -> Lua b
forall a b. Lua (a -> b) -> Lua a -> Lua b
forall a b c. (a -> b -> c) -> Lua a -> Lua b -> Lua c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Lua a -> Lua b -> Lua a
$c<* :: forall a b. Lua a -> Lua b -> Lua a
*> :: Lua a -> Lua b -> Lua b
$c*> :: forall a b. Lua a -> Lua b -> Lua b
liftA2 :: (a -> b -> c) -> Lua a -> Lua b -> Lua c
$cliftA2 :: forall a b c. (a -> b -> c) -> Lua a -> Lua b -> Lua c
<*> :: Lua (a -> b) -> Lua a -> Lua b
$c<*> :: forall a b. Lua (a -> b) -> Lua a -> Lua b
pure :: a -> Lua a
$cpure :: forall a. a -> Lua a
$cp1Applicative :: Functor Lua
Applicative
    , a -> Lua b -> Lua a
(a -> b) -> Lua a -> Lua b
(forall a b. (a -> b) -> Lua a -> Lua b)
-> (forall a b. a -> Lua b -> Lua a) -> Functor Lua
forall a b. a -> Lua b -> Lua a
forall a b. (a -> b) -> Lua a -> Lua b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Lua b -> Lua a
$c<$ :: forall a b. a -> Lua b -> Lua a
fmap :: (a -> b) -> Lua a -> Lua b
$cfmap :: forall a b. (a -> b) -> Lua a -> Lua b
Functor
    , Applicative Lua
a -> Lua a
Applicative Lua
-> (forall a b. Lua a -> (a -> Lua b) -> Lua b)
-> (forall a b. Lua a -> Lua b -> Lua b)
-> (forall a. a -> Lua a)
-> Monad Lua
Lua a -> (a -> Lua b) -> Lua b
Lua a -> Lua b -> Lua b
forall a. a -> Lua a
forall a b. Lua a -> Lua b -> Lua b
forall a b. Lua a -> (a -> Lua b) -> Lua b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Lua a
$creturn :: forall a. a -> Lua a
>> :: Lua a -> Lua b -> Lua b
$c>> :: forall a b. Lua a -> Lua b -> Lua b
>>= :: Lua a -> (a -> Lua b) -> Lua b
$c>>= :: forall a b. Lua a -> (a -> Lua b) -> Lua b
$cp1Monad :: Applicative Lua
Monad
    , MonadThrow Lua
MonadThrow Lua
-> (forall e a. Exception e => Lua a -> (e -> Lua a) -> Lua a)
-> MonadCatch Lua
Lua a -> (e -> Lua a) -> Lua a
forall e a. Exception e => Lua a -> (e -> Lua a) -> Lua a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: Lua a -> (e -> Lua a) -> Lua a
$ccatch :: forall e a. Exception e => Lua a -> (e -> Lua a) -> Lua a
$cp1MonadCatch :: MonadThrow Lua
MonadCatch
    , Monad Lua
Monad Lua -> (forall a. IO a -> Lua a) -> MonadIO Lua
IO a -> Lua a
forall a. IO a -> Lua a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> Lua a
$cliftIO :: forall a. IO a -> Lua a
$cp1MonadIO :: Monad Lua
MonadIO
    , MonadCatch Lua
MonadCatch Lua
-> (forall b. ((forall a. Lua a -> Lua a) -> Lua b) -> Lua b)
-> (forall b. ((forall a. Lua a -> Lua a) -> Lua b) -> Lua b)
-> (forall a b c.
    Lua a -> (a -> ExitCase b -> Lua c) -> (a -> Lua b) -> Lua (b, c))
-> MonadMask Lua
Lua a -> (a -> ExitCase b -> Lua c) -> (a -> Lua b) -> Lua (b, c)
((forall a. Lua a -> Lua a) -> Lua b) -> Lua b
((forall a. Lua a -> Lua a) -> Lua b) -> Lua b
forall b. ((forall a. Lua a -> Lua a) -> Lua b) -> Lua b
forall a b c.
Lua a -> (a -> ExitCase b -> Lua c) -> (a -> Lua b) -> Lua (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
generalBracket :: Lua a -> (a -> ExitCase b -> Lua c) -> (a -> Lua b) -> Lua (b, c)
$cgeneralBracket :: forall a b c.
Lua a -> (a -> ExitCase b -> Lua c) -> (a -> Lua b) -> Lua (b, c)
uninterruptibleMask :: ((forall a. Lua a -> Lua a) -> Lua b) -> Lua b
$cuninterruptibleMask :: forall b. ((forall a. Lua a -> Lua a) -> Lua b) -> Lua b
mask :: ((forall a. Lua a -> Lua a) -> Lua b) -> Lua b
$cmask :: forall b. ((forall a. Lua a -> Lua a) -> Lua b) -> Lua b
$cp1MonadMask :: MonadCatch Lua
MonadMask
    , MonadReader LuaEnvironment
    , Monad Lua
e -> Lua a
Monad Lua
-> (forall e a. Exception e => e -> Lua a) -> MonadThrow Lua
forall e a. Exception e => e -> Lua a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: e -> Lua a
$cthrowM :: forall e a. Exception e => e -> Lua a
$cp1MonadThrow :: Monad Lua
MonadThrow
    )

-- | Turn a function of typ @Lua.State -> IO a@ into a monadic Lua operation.
liftLua :: (State -> IO a) -> Lua a
liftLua :: (State -> IO a) -> Lua a
liftLua State -> IO a
f = Lua State
state Lua State -> (State -> Lua a) -> Lua a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO a -> Lua a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Lua a) -> (State -> IO a) -> State -> Lua a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> IO a
f

-- | Turn a function of typ @Lua.State -> a -> IO b@ into a monadic Lua operation.
liftLua1 :: (State -> a -> IO b) -> a -> Lua b
liftLua1 :: (State -> a -> IO b) -> a -> Lua b
liftLua1 State -> a -> IO b
f a
x = (State -> IO b) -> Lua b
forall a. (State -> IO a) -> Lua a
liftLua ((State -> IO b) -> Lua b) -> (State -> IO b) -> Lua b
forall a b. (a -> b) -> a -> b
$ \State
l -> State -> a -> IO b
f State
l a
x

-- | Get the Lua state of this Lua computation.
state :: Lua State
state :: Lua State
state = (LuaEnvironment -> State) -> Lua State
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks LuaEnvironment -> State
luaEnvState

-- | Get the error-to-exception function.
errorConversion :: Lua ErrorConversion
errorConversion :: Lua ErrorConversion
errorConversion = (LuaEnvironment -> ErrorConversion) -> Lua ErrorConversion
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks LuaEnvironment -> ErrorConversion
luaEnvErrorConversion

-- | Run Lua computation with the given Lua state and error-to-exception
-- converter. Any resulting exceptions are left unhandled.
runWithConverter :: ErrorConversion -> State -> Lua a -> IO a
runWithConverter :: ErrorConversion -> State -> Lua a -> IO a
runWithConverter ErrorConversion
e2e State
l Lua a
s =
  ReaderT LuaEnvironment IO a -> LuaEnvironment -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Lua a -> ReaderT LuaEnvironment IO a
forall a. Lua a -> ReaderT LuaEnvironment IO a
unLua Lua a
s) (ErrorConversion -> State -> LuaEnvironment
LuaEnvironment ErrorConversion
e2e State
l)

-- | Run the given operation, but crash if any Haskell exceptions occur.
unsafeRunWith :: State -> Lua a -> IO a
unsafeRunWith :: State -> Lua a -> IO a
unsafeRunWith = ErrorConversion -> State -> Lua a -> IO a
forall a. ErrorConversion -> State -> Lua a -> IO a
runWithConverter ErrorConversion
unsafeErrorConversion

-- | Unsafe @'ErrorConversion'@; no proper error handling is attempted,
-- any error leads to a crash.
unsafeErrorConversion :: ErrorConversion
unsafeErrorConversion :: ErrorConversion
unsafeErrorConversion = ErrorConversion :: (forall a. State -> IO a)
-> (forall a. String -> Lua a -> Lua a)
-> (forall a. Lua a -> Lua a -> Lua a)
-> (Lua NumResults -> Lua NumResults)
-> ErrorConversion
ErrorConversion
  { errorToException :: forall a. State -> IO a
errorToException = IO a -> State -> IO a
forall a b. a -> b -> a
const (String -> IO a
forall a. HasCallStack => String -> a
error String
"An unrecoverable Lua error occured.")
  , addContextToException :: forall a. String -> Lua a -> Lua a
addContextToException = (Lua a -> Lua a) -> String -> Lua a -> Lua a
forall a b. a -> b -> a
const Lua a -> Lua a
forall a. a -> a
id
  , alternative :: forall a. Lua a -> Lua a -> Lua a
alternative = forall a. Lua a -> Lua a -> Lua a
forall a b. a -> b -> a
const
  , exceptionToError :: Lua NumResults -> Lua NumResults
exceptionToError = Lua NumResults -> Lua NumResults
forall a. a -> a
id
  }

-- | Stack index of the nth element from the top of the stack.
nthFromTop :: CInt -> StackIndex
nthFromTop :: CInt -> StackIndex
nthFromTop CInt
n = CInt -> StackIndex
StackIndex (-CInt
n)
{-# INLINABLE nthFromTop #-}

-- | Stack index of the nth element from the top of the stack.
nth :: CInt -> StackIndex
nth :: CInt -> StackIndex
nth = CInt -> StackIndex
nthFromTop
{-# INLINABLE nth #-}

-- | Stack index of the nth element from the bottom of the stack.
nthFromBottom :: CInt -> StackIndex
nthFromBottom :: CInt -> StackIndex
nthFromBottom = CInt -> StackIndex
StackIndex
{-# INLINABLE nthFromBottom #-}

-- | Top of the stack
top :: StackIndex
top :: StackIndex
top = -StackIndex
1
{-# INLINABLE top #-}

-- | Top of the stack
stackTop :: StackIndex
stackTop :: StackIndex
stackTop = StackIndex
top
{-# INLINABLE stackTop #-}

-- | Bottom of the stack
stackBottom :: StackIndex
stackBottom :: StackIndex
stackBottom = StackIndex
1
{-# INLINABLE stackBottom #-}