{-# LINE 1 "src/Foreign/Lua/Core/Types.hsc" #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RankNTypes #-}
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 (..)
, nthFromBottom
, nthFromTop
, stackTop
, stackBottom
, NumArgs (..)
, NumResults (..)
, RelationalOperator (..)
, fromRelationalOperator
, Status (..)
, StatusCode (..)
, toStatus
, Reference (..)
, fromReference
, toReference
) where
import Prelude hiding (Integer, EQ, LT)
import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow)
import Control.Monad.Reader (ReaderT (..), MonadReader, MonadIO, asks, liftIO)
import Data.Int (Int64)
{-# LINE 70 "src/Foreign/Lua/Core/Types.hsc" #-}
import Foreign.C (CChar, CInt, CSize)
import Foreign.Ptr (FunPtr, Ptr)
import Foreign.Storable (Storable)
import GHC.Generics (Generic)
data ErrorConversion = ErrorConversion
{ errorToException :: forall a . State -> IO a
, addContextToException :: forall a . String -> Lua a -> Lua a
, alternative :: forall a . Lua a -> Lua a -> Lua a
, exceptionToError :: Lua NumResults -> Lua NumResults
}
data LuaEnvironment = LuaEnvironment
{ luaEnvErrorConversion :: ErrorConversion
, luaEnvState :: State
}
newtype Lua a = Lua { unLua :: ReaderT LuaEnvironment IO a }
deriving
( Applicative
, Functor
, Monad
, MonadCatch
, MonadIO
, MonadMask
, MonadReader LuaEnvironment
, MonadThrow
)
liftLua :: (State -> IO a) -> Lua a
liftLua f = state >>= liftIO . f
liftLua1 :: (State -> a -> IO b) -> a -> Lua b
liftLua1 f x = liftLua $ \l -> f l x
state :: Lua State
state = asks luaEnvState
errorConversion :: Lua ErrorConversion
errorConversion = asks luaEnvErrorConversion
runWithConverter :: ErrorConversion -> State -> Lua a -> IO a
runWithConverter e2e l s =
runReaderT (unLua s) (LuaEnvironment e2e l)
unsafeRunWith :: State -> Lua a -> IO a
unsafeRunWith = runWithConverter unsafeErrorConversion
unsafeErrorConversion :: ErrorConversion
unsafeErrorConversion = ErrorConversion
{ errorToException = const (error "An unrecoverable Lua error occured.")
, addContextToException = const id
, alternative = const
, exceptionToError = id
}
newtype State = State (Ptr ()) deriving (Eq, Generic)
type CFunction = FunPtr (State -> IO NumResults)
type Reader = FunPtr (State -> Ptr () -> Ptr CSize -> IO (Ptr CChar))
newtype Integer = Integer Int64
{-# LINE 193 "src/Foreign/Lua/Core/Types.hsc" #-}
deriving (Bounded, Enum, Eq, Integral, Num, Ord, Real, Show)
newtype Number = Number Double
{-# LINE 202 "src/Foreign/Lua/Core/Types.hsc" #-}
deriving (Eq, Floating, Fractional, Num, Ord, Real, RealFloat, RealFrac, Show)
newtype LuaBool = LuaBool CInt
deriving (Eq, Storable, Show)
true :: LuaBool
true = LuaBool 1
false :: LuaBool
false = LuaBool 0
fromLuaBool :: LuaBool -> Bool
fromLuaBool (LuaBool 0) = False
fromLuaBool _ = True
{-# INLINABLE fromLuaBool #-}
toLuaBool :: Bool -> LuaBool
toLuaBool True = true
toLuaBool False = false
{-# INLINABLE toLuaBool #-}
data Type
= TypeNone
| TypeNil
| TypeBoolean
| TypeLightUserdata
| TypeNumber
| TypeString
| TypeTable
| TypeFunction
| TypeUserdata
| TypeThread
deriving (Bounded, Eq, Ord, Show)
newtype TypeCode = TypeCode { fromTypeCode :: CInt }
deriving (Eq, Ord, Show)
instance Enum Type where
fromEnum = fromIntegral . fromTypeCode . fromType
toEnum = toType . TypeCode . fromIntegral
fromType :: Type -> TypeCode
fromType tp = TypeCode $ case tp of
TypeNone -> -1
{-# LINE 266 "src/Foreign/Lua/Core/Types.hsc" #-}
TypeNil -> 0
{-# LINE 267 "src/Foreign/Lua/Core/Types.hsc" #-}
TypeBoolean -> 1
{-# LINE 268 "src/Foreign/Lua/Core/Types.hsc" #-}
TypeLightUserdata -> 2
{-# LINE 269 "src/Foreign/Lua/Core/Types.hsc" #-}
TypeNumber -> 3
{-# LINE 270 "src/Foreign/Lua/Core/Types.hsc" #-}
TypeString -> 4
{-# LINE 271 "src/Foreign/Lua/Core/Types.hsc" #-}
TypeTable -> 5
{-# LINE 272 "src/Foreign/Lua/Core/Types.hsc" #-}
TypeFunction -> 6
{-# LINE 273 "src/Foreign/Lua/Core/Types.hsc" #-}
TypeUserdata -> 7
{-# LINE 274 "src/Foreign/Lua/Core/Types.hsc" #-}
TypeThread -> 8
{-# LINE 275 "src/Foreign/Lua/Core/Types.hsc" #-}
toType :: TypeCode -> Type
toType (TypeCode c) = case c of
-1 -> TypeNone
{-# LINE 280 "src/Foreign/Lua/Core/Types.hsc" #-}
0 -> TypeNil
{-# LINE 281 "src/Foreign/Lua/Core/Types.hsc" #-}
1 -> TypeBoolean
{-# LINE 282 "src/Foreign/Lua/Core/Types.hsc" #-}
2 -> TypeLightUserdata
{-# LINE 283 "src/Foreign/Lua/Core/Types.hsc" #-}
3 -> TypeNumber
{-# LINE 284 "src/Foreign/Lua/Core/Types.hsc" #-}
4 -> TypeString
{-# LINE 285 "src/Foreign/Lua/Core/Types.hsc" #-}
5 -> TypeTable
{-# LINE 286 "src/Foreign/Lua/Core/Types.hsc" #-}
6 -> TypeFunction
{-# LINE 287 "src/Foreign/Lua/Core/Types.hsc" #-}
7 -> TypeUserdata
{-# LINE 288 "src/Foreign/Lua/Core/Types.hsc" #-}
8 -> TypeThread
{-# LINE 289 "src/Foreign/Lua/Core/Types.hsc" #-}
_ -> error ("No Type corresponding to " ++ show c)
data RelationalOperator
= EQ
| LT
| LE
deriving (Eq, Ord, Show)
fromRelationalOperator :: RelationalOperator -> CInt
fromRelationalOperator EQ = 0
{-# LINE 305 "src/Foreign/Lua/Core/Types.hsc" #-}
fromRelationalOperator LT = 1
{-# LINE 306 "src/Foreign/Lua/Core/Types.hsc" #-}
fromRelationalOperator LE = 2
{-# LINE 307 "src/Foreign/Lua/Core/Types.hsc" #-}
{-# INLINABLE fromRelationalOperator #-}
data Status
= OK
| Yield
| ErrRun
| ErrSyntax
| ErrMem
| ErrErr
| ErrGcmm
| ErrFile
deriving (Eq, Show)
toStatus :: StatusCode -> Status
toStatus (StatusCode c) = case c of
0 -> OK
{-# LINE 330 "src/Foreign/Lua/Core/Types.hsc" #-}
1 -> Yield
{-# LINE 331 "src/Foreign/Lua/Core/Types.hsc" #-}
2 -> ErrRun
{-# LINE 332 "src/Foreign/Lua/Core/Types.hsc" #-}
3 -> ErrSyntax
{-# LINE 333 "src/Foreign/Lua/Core/Types.hsc" #-}
4 -> ErrMem
{-# LINE 334 "src/Foreign/Lua/Core/Types.hsc" #-}
5 -> ErrGcmm
{-# LINE 335 "src/Foreign/Lua/Core/Types.hsc" #-}
6 -> ErrErr
{-# LINE 336 "src/Foreign/Lua/Core/Types.hsc" #-}
7 -> ErrFile
{-# LINE 337 "src/Foreign/Lua/Core/Types.hsc" #-}
n -> error $ "Cannot convert (" ++ show n ++ ") to Status"
{-# INLINABLE toStatus #-}
newtype StatusCode = StatusCode CInt deriving Eq
data GCCONTROL
= GCSTOP
| GCRESTART
| GCCOLLECT
| GCCOUNT
| GCCOUNTB
| GCSTEP
| GCSETPAUSE
| GCSETSTEPMUL
deriving (Enum, Eq, Ord, Show)
newtype StackIndex = StackIndex { fromStackIndex :: CInt }
deriving (Enum, Eq, Num, Ord, Show)
nthFromTop :: CInt -> StackIndex
nthFromTop n = StackIndex (-n)
{-# INLINABLE nthFromTop #-}
nthFromBottom :: CInt -> StackIndex
nthFromBottom = StackIndex
{-# INLINABLE nthFromBottom #-}
stackTop :: StackIndex
stackTop = -1
{-# INLINABLE stackTop #-}
stackBottom :: StackIndex
stackBottom = 1
{-# INLINABLE stackBottom #-}
newtype NumArgs = NumArgs { fromNumArgs :: CInt }
deriving (Eq, Num, Ord, Show)
newtype NumResults = NumResults { fromNumResults :: CInt }
deriving (Eq, Num, Ord, Show)
refnil :: CInt
refnil = -1
{-# LINE 404 "src/Foreign/Lua/Core/Types.hsc" #-}
data Reference =
Reference CInt
| RefNil
deriving (Eq, Show)
fromReference :: Reference -> CInt
fromReference = \case
Reference x -> x
RefNil -> refnil
toReference :: CInt -> Reference
toReference x =
if x == refnil
then RefNil
else Reference x