{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-|
Module      : HsLua.Core.Types
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)

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

This module has mostly been moved to @'Lua.Types'@ and
currently re-exports that module. This module might be removed in
the future.
-}
module HsLua.Core.Types
  ( LuaE (..)
  , LuaEnvironment (..)
  , State (..)
  , Reader
  , liftLua
  , liftLua1
  , state
  , runWith
  , unsafeRunWith
  , GCControl (..)
  , toGCcode
  , toGCdata
  , Type (..)
  , fromType
  , toType
  , liftIO
  , CFunction
  , PreCFunction
  , HaskellFunction
  , LuaBool (..)
  , fromLuaBool
  , toLuaBool
  , Integer (..)
  , Number (..)
  , StackIndex (..)
  , registryindex
  , NumArgs (..)
  , NumResults (..)
  , multret
  , RelationalOperator (..)
  , fromRelationalOperator
  , Status (..)
  , toStatus
    -- * References
  , Reference (..)
  , fromReference
  , toReference
  , noref
  , refnil
    -- * Stack index helpers
  , nthTop
  , nthBottom
  , nth
  , top
    -- * Table field names
  , Name (..)
  ) 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.ByteString (ByteString)
import Data.String (IsString (..))
import Foreign.C (CInt)
import Lua (nth, nthBottom, nthTop, top)
import Lua.Constants
import Lua.Types
import Lua.Auxiliary
  ( Reference (..)
  , fromReference
  , toReference
  )
import qualified HsLua.Core.Utf8 as Utf8
#if !MIN_VERSION_base(4,12,0)
import Data.Semigroup (Semigroup)
#endif

-- | Environment in which Lua computations are evaluated.
newtype LuaEnvironment = LuaEnvironment
  { 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 LuaE e a = Lua { LuaE e a -> ReaderT LuaEnvironment IO a
unLua :: ReaderT LuaEnvironment IO a }
  deriving
    ( Functor (LuaE e)
a -> LuaE e a
Functor (LuaE e)
-> (forall a. a -> LuaE e a)
-> (forall a b. LuaE e (a -> b) -> LuaE e a -> LuaE e b)
-> (forall a b c.
    (a -> b -> c) -> LuaE e a -> LuaE e b -> LuaE e c)
-> (forall a b. LuaE e a -> LuaE e b -> LuaE e b)
-> (forall a b. LuaE e a -> LuaE e b -> LuaE e a)
-> Applicative (LuaE e)
LuaE e a -> LuaE e b -> LuaE e b
LuaE e a -> LuaE e b -> LuaE e a
LuaE e (a -> b) -> LuaE e a -> LuaE e b
(a -> b -> c) -> LuaE e a -> LuaE e b -> LuaE e c
forall e. Functor (LuaE e)
forall a. a -> LuaE e a
forall e a. a -> LuaE e a
forall a b. LuaE e a -> LuaE e b -> LuaE e a
forall a b. LuaE e a -> LuaE e b -> LuaE e b
forall a b. LuaE e (a -> b) -> LuaE e a -> LuaE e b
forall e a b. LuaE e a -> LuaE e b -> LuaE e a
forall e a b. LuaE e a -> LuaE e b -> LuaE e b
forall e a b. LuaE e (a -> b) -> LuaE e a -> LuaE e b
forall a b c. (a -> b -> c) -> LuaE e a -> LuaE e b -> LuaE e c
forall e a b c. (a -> b -> c) -> LuaE e a -> LuaE e b -> LuaE e 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
<* :: LuaE e a -> LuaE e b -> LuaE e a
$c<* :: forall e a b. LuaE e a -> LuaE e b -> LuaE e a
*> :: LuaE e a -> LuaE e b -> LuaE e b
$c*> :: forall e a b. LuaE e a -> LuaE e b -> LuaE e b
liftA2 :: (a -> b -> c) -> LuaE e a -> LuaE e b -> LuaE e c
$cliftA2 :: forall e a b c. (a -> b -> c) -> LuaE e a -> LuaE e b -> LuaE e c
<*> :: LuaE e (a -> b) -> LuaE e a -> LuaE e b
$c<*> :: forall e a b. LuaE e (a -> b) -> LuaE e a -> LuaE e b
pure :: a -> LuaE e a
$cpure :: forall e a. a -> LuaE e a
$cp1Applicative :: forall e. Functor (LuaE e)
Applicative
    , a -> LuaE e b -> LuaE e a
(a -> b) -> LuaE e a -> LuaE e b
(forall a b. (a -> b) -> LuaE e a -> LuaE e b)
-> (forall a b. a -> LuaE e b -> LuaE e a) -> Functor (LuaE e)
forall a b. a -> LuaE e b -> LuaE e a
forall a b. (a -> b) -> LuaE e a -> LuaE e b
forall e a b. a -> LuaE e b -> LuaE e a
forall e a b. (a -> b) -> LuaE e a -> LuaE e b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> LuaE e b -> LuaE e a
$c<$ :: forall e a b. a -> LuaE e b -> LuaE e a
fmap :: (a -> b) -> LuaE e a -> LuaE e b
$cfmap :: forall e a b. (a -> b) -> LuaE e a -> LuaE e b
Functor
    , Applicative (LuaE e)
a -> LuaE e a
Applicative (LuaE e)
-> (forall a b. LuaE e a -> (a -> LuaE e b) -> LuaE e b)
-> (forall a b. LuaE e a -> LuaE e b -> LuaE e b)
-> (forall a. a -> LuaE e a)
-> Monad (LuaE e)
LuaE e a -> (a -> LuaE e b) -> LuaE e b
LuaE e a -> LuaE e b -> LuaE e b
forall e. Applicative (LuaE e)
forall a. a -> LuaE e a
forall e a. a -> LuaE e a
forall a b. LuaE e a -> LuaE e b -> LuaE e b
forall a b. LuaE e a -> (a -> LuaE e b) -> LuaE e b
forall e a b. LuaE e a -> LuaE e b -> LuaE e b
forall e a b. LuaE e a -> (a -> LuaE e b) -> LuaE e 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 -> LuaE e a
$creturn :: forall e a. a -> LuaE e a
>> :: LuaE e a -> LuaE e b -> LuaE e b
$c>> :: forall e a b. LuaE e a -> LuaE e b -> LuaE e b
>>= :: LuaE e a -> (a -> LuaE e b) -> LuaE e b
$c>>= :: forall e a b. LuaE e a -> (a -> LuaE e b) -> LuaE e b
$cp1Monad :: forall e. Applicative (LuaE e)
Monad
    , MonadThrow (LuaE e)
MonadThrow (LuaE e)
-> (forall e a.
    Exception e =>
    LuaE e a -> (e -> LuaE e a) -> LuaE e a)
-> MonadCatch (LuaE e)
LuaE e a -> (e -> LuaE e a) -> LuaE e a
forall e. MonadThrow (LuaE e)
forall e a. Exception e => LuaE e a -> (e -> LuaE e a) -> LuaE e a
forall e e a.
Exception e =>
LuaE e a -> (e -> LuaE e a) -> LuaE e a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: LuaE e a -> (e -> LuaE e a) -> LuaE e a
$ccatch :: forall e e a.
Exception e =>
LuaE e a -> (e -> LuaE e a) -> LuaE e a
$cp1MonadCatch :: forall e. MonadThrow (LuaE e)
MonadCatch
    , Monad (LuaE e)
Monad (LuaE e) -> (forall a. IO a -> LuaE e a) -> MonadIO (LuaE e)
IO a -> LuaE e a
forall e. Monad (LuaE e)
forall a. IO a -> LuaE e a
forall e a. IO a -> LuaE e a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> LuaE e a
$cliftIO :: forall e a. IO a -> LuaE e a
$cp1MonadIO :: forall e. Monad (LuaE e)
MonadIO
    , MonadCatch (LuaE e)
MonadCatch (LuaE e)
-> (forall b.
    ((forall a. LuaE e a -> LuaE e a) -> LuaE e b) -> LuaE e b)
-> (forall b.
    ((forall a. LuaE e a -> LuaE e a) -> LuaE e b) -> LuaE e b)
-> (forall a b c.
    LuaE e a
    -> (a -> ExitCase b -> LuaE e c)
    -> (a -> LuaE e b)
    -> LuaE e (b, c))
-> MonadMask (LuaE e)
LuaE e a
-> (a -> ExitCase b -> LuaE e c)
-> (a -> LuaE e b)
-> LuaE e (b, c)
((forall a. LuaE e a -> LuaE e a) -> LuaE e b) -> LuaE e b
((forall a. LuaE e a -> LuaE e a) -> LuaE e b) -> LuaE e b
forall e. MonadCatch (LuaE e)
forall b.
((forall a. LuaE e a -> LuaE e a) -> LuaE e b) -> LuaE e b
forall e b.
((forall a. LuaE e a -> LuaE e a) -> LuaE e b) -> LuaE e b
forall a b c.
LuaE e a
-> (a -> ExitCase b -> LuaE e c)
-> (a -> LuaE e b)
-> LuaE e (b, c)
forall e a b c.
LuaE e a
-> (a -> ExitCase b -> LuaE e c)
-> (a -> LuaE e b)
-> LuaE e (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 :: LuaE e a
-> (a -> ExitCase b -> LuaE e c)
-> (a -> LuaE e b)
-> LuaE e (b, c)
$cgeneralBracket :: forall e a b c.
LuaE e a
-> (a -> ExitCase b -> LuaE e c)
-> (a -> LuaE e b)
-> LuaE e (b, c)
uninterruptibleMask :: ((forall a. LuaE e a -> LuaE e a) -> LuaE e b) -> LuaE e b
$cuninterruptibleMask :: forall e b.
((forall a. LuaE e a -> LuaE e a) -> LuaE e b) -> LuaE e b
mask :: ((forall a. LuaE e a -> LuaE e a) -> LuaE e b) -> LuaE e b
$cmask :: forall e b.
((forall a. LuaE e a -> LuaE e a) -> LuaE e b) -> LuaE e b
$cp1MonadMask :: forall e. MonadCatch (LuaE e)
MonadMask
    , MonadReader LuaEnvironment
    , Monad (LuaE e)
e -> LuaE e a
Monad (LuaE e)
-> (forall e a. Exception e => e -> LuaE e a)
-> MonadThrow (LuaE e)
forall e. Monad (LuaE e)
forall e a. Exception e => e -> LuaE e a
forall e e a. Exception e => e -> LuaE e a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: e -> LuaE e a
$cthrowM :: forall e e a. Exception e => e -> LuaE e a
$cp1MonadThrow :: forall e. Monad (LuaE e)
MonadThrow
    )

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

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

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

-- | Run Lua computation with the given Lua state. Exception handling is
-- left to the caller; resulting exceptions are left unhandled.
runWith :: State -> LuaE e a -> IO a
runWith :: State -> LuaE e a -> IO a
runWith State
l LuaE e a
s = ReaderT LuaEnvironment IO a -> LuaEnvironment -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (LuaE e a -> ReaderT LuaEnvironment IO a
forall e a. LuaE e a -> ReaderT LuaEnvironment IO a
unLua LuaE e a
s) (State -> LuaEnvironment
LuaEnvironment State
l)
{-# INLINABLE runWith #-}

-- | Run the given operation, but crash if any Haskell exceptions occur.
unsafeRunWith :: State -> LuaE e a -> IO a
unsafeRunWith :: State -> LuaE e a -> IO a
unsafeRunWith = State -> LuaE e a -> IO a
forall e a. State -> LuaE e a -> IO a
runWith

-- | Haskell function that can be called from Lua.
-- The HsLua equivallent of a 'PreCFunction'.
type HaskellFunction e = LuaE e NumResults

--
-- Type of Lua values
--

-- | Enumeration used as type tag.
-- See <https://www.lua.org/manual/5.4/manual.html#lua_type lua_type>.
data Type
  = TypeNone           -- ^ non-valid stack index
  | TypeNil            -- ^ type of Lua's @nil@ value
  | TypeBoolean        -- ^ type of Lua booleans
  | TypeLightUserdata  -- ^ type of light userdata
  | TypeNumber         -- ^ type of Lua numbers. See @'Lua.Number'@
  | TypeString         -- ^ type of Lua string values
  | TypeTable          -- ^ type of Lua tables
  | TypeFunction       -- ^ type of functions, either normal or @'CFunction'@
  | TypeUserdata       -- ^ type of full user data
  | TypeThread         -- ^ type of Lua threads
  deriving (Type
Type -> Type -> Bounded Type
forall a. a -> a -> Bounded a
maxBound :: Type
$cmaxBound :: Type
minBound :: Type
$cminBound :: Type
Bounded, Type -> Type -> Bool
(Type -> Type -> Bool) -> (Type -> Type -> Bool) -> Eq Type
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Type -> Type -> Bool
$c/= :: Type -> Type -> Bool
== :: Type -> Type -> Bool
$c== :: Type -> Type -> Bool
Eq, Eq Type
Eq Type
-> (Type -> Type -> Ordering)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Type)
-> (Type -> Type -> Type)
-> Ord Type
Type -> Type -> Bool
Type -> Type -> Ordering
Type -> Type -> Type
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Type -> Type -> Type
$cmin :: Type -> Type -> Type
max :: Type -> Type -> Type
$cmax :: Type -> Type -> Type
>= :: Type -> Type -> Bool
$c>= :: Type -> Type -> Bool
> :: Type -> Type -> Bool
$c> :: Type -> Type -> Bool
<= :: Type -> Type -> Bool
$c<= :: Type -> Type -> Bool
< :: Type -> Type -> Bool
$c< :: Type -> Type -> Bool
compare :: Type -> Type -> Ordering
$ccompare :: Type -> Type -> Ordering
$cp1Ord :: Eq Type
Ord, Int -> Type -> ShowS
[Type] -> ShowS
Type -> String
(Int -> Type -> ShowS)
-> (Type -> String) -> ([Type] -> ShowS) -> Show Type
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Type] -> ShowS
$cshowList :: [Type] -> ShowS
show :: Type -> String
$cshow :: Type -> String
showsPrec :: Int -> Type -> ShowS
$cshowsPrec :: Int -> Type -> ShowS
Show)

instance Enum Type where
  fromEnum :: Type -> Int
fromEnum = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> (Type -> CInt) -> Type -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeCode -> CInt
fromTypeCode (TypeCode -> CInt) -> (Type -> TypeCode) -> Type -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> TypeCode
fromType
  toEnum :: Int -> Type
toEnum = TypeCode -> Type
toType (TypeCode -> Type) -> (Int -> TypeCode) -> Int -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> TypeCode
TypeCode (CInt -> TypeCode) -> (Int -> CInt) -> Int -> TypeCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Convert a Lua 'Type' to a type code which can be passed to the C
-- API.
fromType :: Type -> TypeCode
fromType :: Type -> TypeCode
fromType = \case
  Type
TypeNone          -> TypeCode
LUA_TNONE
  Type
TypeNil           -> TypeCode
LUA_TNIL
  Type
TypeBoolean       -> TypeCode
LUA_TBOOLEAN
  Type
TypeLightUserdata -> TypeCode
LUA_TLIGHTUSERDATA
  Type
TypeNumber        -> TypeCode
LUA_TNUMBER
  Type
TypeString        -> TypeCode
LUA_TSTRING
  Type
TypeTable         -> TypeCode
LUA_TTABLE
  Type
TypeFunction      -> TypeCode
LUA_TFUNCTION
  Type
TypeUserdata      -> TypeCode
LUA_TUSERDATA
  Type
TypeThread        -> TypeCode
LUA_TTHREAD
{-# INLINABLE fromType #-}

-- | Convert numerical code to Lua 'Type'.
toType :: TypeCode -> Type
toType :: TypeCode -> Type
toType = \case
  TypeCode
LUA_TNONE          -> Type
TypeNone
  TypeCode
LUA_TNIL           -> Type
TypeNil
  TypeCode
LUA_TBOOLEAN       -> Type
TypeBoolean
  TypeCode
LUA_TLIGHTUSERDATA -> Type
TypeLightUserdata
  TypeCode
LUA_TNUMBER        -> Type
TypeNumber
  TypeCode
LUA_TSTRING        -> Type
TypeString
  TypeCode
LUA_TTABLE         -> Type
TypeTable
  TypeCode
LUA_TFUNCTION      -> Type
TypeFunction
  TypeCode
LUA_TUSERDATA      -> Type
TypeUserdata
  TypeCode
LUA_TTHREAD        -> Type
TypeThread
  TypeCode CInt
c         -> String -> Type
forall a. HasCallStack => String -> a
error (String
"No Type corresponding to " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CInt -> String
forall a. Show a => a -> String
show CInt
c)
{-# INLINABLE toType #-}


--
-- Thread status
--

-- | Lua status values.
data Status
  = OK        -- ^ success
  | Yield     -- ^ yielding / suspended coroutine
  | ErrRun    -- ^ a runtime rror
  | ErrSyntax -- ^ syntax error during precompilation
  | ErrMem    -- ^ memory allocation (out-of-memory) error.
  | ErrErr    -- ^ error while running the message handler.
  | ErrFile   -- ^ opening or reading a file failed.
  deriving (Status -> Status -> Bool
(Status -> Status -> Bool)
-> (Status -> Status -> Bool) -> Eq Status
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Status -> Status -> Bool
$c/= :: Status -> Status -> Bool
== :: Status -> Status -> Bool
$c== :: Status -> Status -> Bool
Eq, Int -> Status -> ShowS
[Status] -> ShowS
Status -> String
(Int -> Status -> ShowS)
-> (Status -> String) -> ([Status] -> ShowS) -> Show Status
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Status] -> ShowS
$cshowList :: [Status] -> ShowS
show :: Status -> String
$cshow :: Status -> String
showsPrec :: Int -> Status -> ShowS
$cshowsPrec :: Int -> Status -> ShowS
Show)

-- | Convert C integer constant to @'Status'@.
toStatus :: StatusCode -> Status
toStatus :: StatusCode -> Status
toStatus = \case
  StatusCode
LUA_OK        -> Status
OK
  StatusCode
LUA_YIELD     -> Status
Yield
  StatusCode
LUA_ERRRUN    -> Status
ErrRun
  StatusCode
LUA_ERRSYNTAX -> Status
ErrSyntax
  StatusCode
LUA_ERRMEM    -> Status
ErrMem
  StatusCode
LUA_ERRERR    -> Status
ErrErr
  StatusCode
LUA_ERRFILE   -> Status
ErrFile
  StatusCode CInt
n  -> String -> Status
forall a. HasCallStack => String -> a
error (String -> Status) -> String -> Status
forall a b. (a -> b) -> a -> b
$ String
"Cannot convert (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ CInt -> String
forall a. Show a => a -> String
show CInt
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") to Status"
{-# INLINABLE toStatus #-}

--
-- Relational Operator
--

-- | Lua comparison operations.
data RelationalOperator
  = EQ -- ^ Correponds to Lua's equality (==) operator.
  | LT -- ^ Correponds to Lua's strictly-lesser-than (<) operator
  | LE -- ^ Correponds to Lua's lesser-or-equal (<=) operator
  deriving (RelationalOperator -> RelationalOperator -> Bool
(RelationalOperator -> RelationalOperator -> Bool)
-> (RelationalOperator -> RelationalOperator -> Bool)
-> Eq RelationalOperator
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RelationalOperator -> RelationalOperator -> Bool
$c/= :: RelationalOperator -> RelationalOperator -> Bool
== :: RelationalOperator -> RelationalOperator -> Bool
$c== :: RelationalOperator -> RelationalOperator -> Bool
Eq, Eq RelationalOperator
Eq RelationalOperator
-> (RelationalOperator -> RelationalOperator -> Ordering)
-> (RelationalOperator -> RelationalOperator -> Bool)
-> (RelationalOperator -> RelationalOperator -> Bool)
-> (RelationalOperator -> RelationalOperator -> Bool)
-> (RelationalOperator -> RelationalOperator -> Bool)
-> (RelationalOperator -> RelationalOperator -> RelationalOperator)
-> (RelationalOperator -> RelationalOperator -> RelationalOperator)
-> Ord RelationalOperator
RelationalOperator -> RelationalOperator -> Bool
RelationalOperator -> RelationalOperator -> Ordering
RelationalOperator -> RelationalOperator -> RelationalOperator
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RelationalOperator -> RelationalOperator -> RelationalOperator
$cmin :: RelationalOperator -> RelationalOperator -> RelationalOperator
max :: RelationalOperator -> RelationalOperator -> RelationalOperator
$cmax :: RelationalOperator -> RelationalOperator -> RelationalOperator
>= :: RelationalOperator -> RelationalOperator -> Bool
$c>= :: RelationalOperator -> RelationalOperator -> Bool
> :: RelationalOperator -> RelationalOperator -> Bool
$c> :: RelationalOperator -> RelationalOperator -> Bool
<= :: RelationalOperator -> RelationalOperator -> Bool
$c<= :: RelationalOperator -> RelationalOperator -> Bool
< :: RelationalOperator -> RelationalOperator -> Bool
$c< :: RelationalOperator -> RelationalOperator -> Bool
compare :: RelationalOperator -> RelationalOperator -> Ordering
$ccompare :: RelationalOperator -> RelationalOperator -> Ordering
$cp1Ord :: Eq RelationalOperator
Ord, Int -> RelationalOperator -> ShowS
[RelationalOperator] -> ShowS
RelationalOperator -> String
(Int -> RelationalOperator -> ShowS)
-> (RelationalOperator -> String)
-> ([RelationalOperator] -> ShowS)
-> Show RelationalOperator
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RelationalOperator] -> ShowS
$cshowList :: [RelationalOperator] -> ShowS
show :: RelationalOperator -> String
$cshow :: RelationalOperator -> String
showsPrec :: Int -> RelationalOperator -> ShowS
$cshowsPrec :: Int -> RelationalOperator -> ShowS
Show)

-- | Convert relation operator to its C representation.
fromRelationalOperator :: RelationalOperator -> OPCode
fromRelationalOperator :: RelationalOperator -> OPCode
fromRelationalOperator = \case
  RelationalOperator
EQ -> OPCode
LUA_OPEQ
  RelationalOperator
LT -> OPCode
LUA_OPLT
  RelationalOperator
LE -> OPCode
LUA_OPLE
{-# INLINABLE fromRelationalOperator #-}

--
-- Boolean
--

-- | Convert a @'LuaBool'@ to a Haskell @'Bool'@.
fromLuaBool :: LuaBool -> Bool
fromLuaBool :: LuaBool -> Bool
fromLuaBool LuaBool
FALSE = Bool
False
fromLuaBool LuaBool
_     = Bool
True
{-# INLINABLE fromLuaBool #-}

-- | Convert a Haskell @'Bool'@ to a @'LuaBool'@.
toLuaBool :: Bool -> LuaBool
toLuaBool :: Bool -> LuaBool
toLuaBool Bool
True  = LuaBool
TRUE
toLuaBool Bool
False = LuaBool
FALSE
{-# INLINABLE toLuaBool #-}

--
-- Garbage collection
--

-- | Commands to control the garbage collector.
data GCControl
  = GCStop               -- ^ stops the garbage collector.
  | GCRestart            -- ^ restarts the garbage collector
  | GCCollect            -- ^ performs a full garbage-collection cycle.
  | GCCount              -- ^ returns the current amount of memory (in
                         -- Kbytes) in use by Lua.
  | GCCountb             -- ^ returns the remainder of dividing the current
                         -- amount of bytes of memory in use by Lua by 1024.
  | GCStep CInt          -- ^ performs an incremental step of garbage
                         -- collection, corresponding to the allocation of
                         -- @stepsize@ Kbytes.
  | GCInc CInt CInt CInt -- ^ Changes the collector to incremental mode
                         -- with the given parameters (see
                         -- <https://www.lua.org/manual/5.4/manual.html#2.5.1
                         -- §2.5.1>). Returns the previous mode
                         -- (@LUA_GCGEN@ or @LUA_GCINC@).
                         -- Parameters: pause, stepmul, and stepsize.
  | GCGen CInt CInt      -- ^ Changes the collector to generational mode
                         -- with the given parameters (see
                         -- <https://www.lua.org/manual/5.4/manual.html#2.5.2
                         -- §2.5.2>). Returns the previous mode
                         -- (@LUA_GCGEN@ or @LUA_GCINC@).
  | GCIsRunning       -- ^ returns a boolean that tells whether the
                      -- collector is running (i.e., not stopped).
  deriving (GCControl -> GCControl -> Bool
(GCControl -> GCControl -> Bool)
-> (GCControl -> GCControl -> Bool) -> Eq GCControl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GCControl -> GCControl -> Bool
$c/= :: GCControl -> GCControl -> Bool
== :: GCControl -> GCControl -> Bool
$c== :: GCControl -> GCControl -> Bool
Eq, Eq GCControl
Eq GCControl
-> (GCControl -> GCControl -> Ordering)
-> (GCControl -> GCControl -> Bool)
-> (GCControl -> GCControl -> Bool)
-> (GCControl -> GCControl -> Bool)
-> (GCControl -> GCControl -> Bool)
-> (GCControl -> GCControl -> GCControl)
-> (GCControl -> GCControl -> GCControl)
-> Ord GCControl
GCControl -> GCControl -> Bool
GCControl -> GCControl -> Ordering
GCControl -> GCControl -> GCControl
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: GCControl -> GCControl -> GCControl
$cmin :: GCControl -> GCControl -> GCControl
max :: GCControl -> GCControl -> GCControl
$cmax :: GCControl -> GCControl -> GCControl
>= :: GCControl -> GCControl -> Bool
$c>= :: GCControl -> GCControl -> Bool
> :: GCControl -> GCControl -> Bool
$c> :: GCControl -> GCControl -> Bool
<= :: GCControl -> GCControl -> Bool
$c<= :: GCControl -> GCControl -> Bool
< :: GCControl -> GCControl -> Bool
$c< :: GCControl -> GCControl -> Bool
compare :: GCControl -> GCControl -> Ordering
$ccompare :: GCControl -> GCControl -> Ordering
$cp1Ord :: Eq GCControl
Ord, Int -> GCControl -> ShowS
[GCControl] -> ShowS
GCControl -> String
(Int -> GCControl -> ShowS)
-> (GCControl -> String)
-> ([GCControl] -> ShowS)
-> Show GCControl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GCControl] -> ShowS
$cshowList :: [GCControl] -> ShowS
show :: GCControl -> String
$cshow :: GCControl -> String
showsPrec :: Int -> GCControl -> ShowS
$cshowsPrec :: Int -> GCControl -> ShowS
Show)

-- | Converts a GCControl command to its corresponding code.
toGCcode :: GCControl -> GCCode
toGCcode :: GCControl -> GCCode
toGCcode = \case
  GCControl
GCStop          -> GCCode
LUA_GCSTOP
  GCControl
GCRestart       -> GCCode
LUA_GCRESTART
  GCControl
GCCollect       -> GCCode
LUA_GCCOLLECT
  GCControl
GCCount         -> GCCode
LUA_GCCOUNT
  GCControl
GCCountb        -> GCCode
LUA_GCCOUNTB
  GCStep CInt
_        -> GCCode
LUA_GCSTEP
  GCControl
GCIsRunning     -> GCCode
LUA_GCISRUNNING
  GCGen {}        -> GCCode
LUA_GCGEN
  GCInc {}        -> GCCode
LUA_GCINC
{-# INLINABLE toGCcode #-}

-- | Returns the data value associated with a GCControl command.
toGCdata :: GCControl -> (CInt, CInt, CInt)
toGCdata :: GCControl -> (CInt, CInt, CInt)
toGCdata = \case
  GCStep CInt
stepsize         -> (CInt
stepsize, CInt
0, CInt
0)
  GCGen CInt
minormul CInt
majormul -> (CInt
minormul, CInt
majormul, CInt
0)
  GCInc CInt
pause CInt
mul CInt
size    -> (CInt
pause, CInt
mul, CInt
size)
  GCControl
_                       -> (CInt
0, CInt
0, CInt
0)
{-# INLINABLE toGCdata #-}

--
-- Special values
--

-- | Option for multiple returns in @'HsLua.Core.pcall'@.
multret :: NumResults
multret :: NumResults
multret = NumResults
LUA_MULTRET

-- | Pseudo stack index of the Lua registry.
registryindex :: StackIndex
registryindex :: StackIndex
registryindex = StackIndex
LUA_REGISTRYINDEX

-- | Value signaling that no reference was created.
refnil :: Int
refnil :: Int
refnil = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
LUA_REFNIL

-- | Value signaling that no reference was found.
noref :: Int
noref :: Int
noref = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
LUA_NOREF

--
-- Field names
--

-- | Name of a function, table field, or chunk; the name must be valid
-- UTF-8 and may not contain any nul characters.
--
-- Implementation note: this is a @newtype@ instead of a simple @type
-- Name = ByteString@ alias so we can define a UTF-8 based 'IsString'
-- instance. Non-ASCII users would have a bad time otherwise.
newtype Name = Name { Name -> ByteString
fromName :: ByteString }
  deriving (Name -> Name -> Bool
(Name -> Name -> Bool) -> (Name -> Name -> Bool) -> Eq Name
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Name -> Name -> Bool
$c/= :: Name -> Name -> Bool
== :: Name -> Name -> Bool
$c== :: Name -> Name -> Bool
Eq, Eq Name
Eq Name
-> (Name -> Name -> Ordering)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Name)
-> (Name -> Name -> Name)
-> Ord Name
Name -> Name -> Bool
Name -> Name -> Ordering
Name -> Name -> Name
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Name -> Name -> Name
$cmin :: Name -> Name -> Name
max :: Name -> Name -> Name
$cmax :: Name -> Name -> Name
>= :: Name -> Name -> Bool
$c>= :: Name -> Name -> Bool
> :: Name -> Name -> Bool
$c> :: Name -> Name -> Bool
<= :: Name -> Name -> Bool
$c<= :: Name -> Name -> Bool
< :: Name -> Name -> Bool
$c< :: Name -> Name -> Bool
compare :: Name -> Name -> Ordering
$ccompare :: Name -> Name -> Ordering
$cp1Ord :: Eq Name
Ord, b -> Name -> Name
NonEmpty Name -> Name
Name -> Name -> Name
(Name -> Name -> Name)
-> (NonEmpty Name -> Name)
-> (forall b. Integral b => b -> Name -> Name)
-> Semigroup Name
forall b. Integral b => b -> Name -> Name
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> Name -> Name
$cstimes :: forall b. Integral b => b -> Name -> Name
sconcat :: NonEmpty Name -> Name
$csconcat :: NonEmpty Name -> Name
<> :: Name -> Name -> Name
$c<> :: Name -> Name -> Name
Semigroup, Int -> Name -> ShowS
[Name] -> ShowS
Name -> String
(Int -> Name -> ShowS)
-> (Name -> String) -> ([Name] -> ShowS) -> Show Name
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Name] -> ShowS
$cshowList :: [Name] -> ShowS
show :: Name -> String
$cshow :: Name -> String
showsPrec :: Int -> Name -> ShowS
$cshowsPrec :: Int -> Name -> ShowS
Show)

instance IsString Name where
  fromString :: String -> Name
fromString = ByteString -> Name
Name (ByteString -> Name) -> (String -> ByteString) -> String -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
Utf8.fromString
  {-# INLINABLE fromString #-}