{-# LINE 1 "src/Foreign/Lua/Raw/Types.hsc" #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-|
Module      : Foreign.Lua.Raw.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.
-}
module Foreign.Lua.Raw.Types
  ( State (..)
  , Reader
  , GCCONTROL (..)
  , Type (..)
  , TypeCode (..)
  , fromType
  , toType
  , CFunction
  , LuaBool (..)
  , false
  , true
  , fromLuaBool
  , toLuaBool
  , Integer (..)
  , Number (..)
  , StackIndex (..)
  , NumArgs (..)
  , NumResults (..)
  , RelationalOperator (..)
  , fromRelationalOperator
  , Status (..)
  , StatusCode (..)
  , toStatus
  ) where


-- required only for LUA_ERRFILE


import Prelude hiding (Integer, EQ, LT)

import Data.Int (Int64)
{-# LINE 48 "src/Foreign/Lua/Raw/Types.hsc" #-}
import Foreign.C (CChar, CInt, CSize)
import Foreign.Ptr (FunPtr, Ptr)
import Foreign.Storable (Storable)
import GHC.Generics (Generic)

-- | An opaque structure that points to a thread and indirectly (through the
-- thread) to the whole state of a Lua interpreter. The Lua library is fully
-- reentrant: it has no global variables. All information about a state is
-- accessible through this structure.
--
-- Synonym for @lua_State *@. See <https://www.lua.org/manual/5.3/#lua_State lua_State>.
newtype State = State (Ptr ()) deriving (State -> State -> Bool
(State -> State -> Bool) -> (State -> State -> Bool) -> Eq State
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: State -> State -> Bool
$c/= :: State -> State -> Bool
== :: State -> State -> Bool
$c== :: State -> State -> Bool
Eq, (forall x. State -> Rep State x)
-> (forall x. Rep State x -> State) -> Generic State
forall x. Rep State x -> State
forall x. State -> Rep State x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep State x -> State
$cfrom :: forall x. State -> Rep State x
Generic)

-- |  Type for C functions.
--
-- In order to communicate properly with Lua, a C function must use the
-- following protocol, which defines the way parameters and results are
-- passed: a C function receives its arguments from Lua in its stack in
-- direct order (the first argument is pushed first). So, when the
-- function starts, @'Foreign.Lua.Core.Functions.gettop'@ returns the
-- number of arguments received by the function. The first argument (if
-- any) is at index 1 and its last argument is at index
-- @'Foreign.Lua.Core.Functions.gettop'@. To return values to Lua, a C
-- function just pushes them onto the stack, in direct order (the first
-- result is pushed first), and returns the number of results. Any other
-- value in the stack below the results will be properly discarded by
-- Lua. Like a Lua function, a C function called by Lua can also return
-- many results.
--
-- See <https://www.lua.org/manual/5.3/manual.html#lua_CFunction lua_CFunction>.
type CFunction = FunPtr (State -> IO NumResults)

-- | The reader function used by @'Foreign.Lua.Core.Functions.load'@.
-- Every time it needs another piece of the chunk, lua_load calls the
-- reader, passing along its data parameter. The reader must return a
-- pointer to a block of memory with a new piece of the chunk and set
-- size to the block size. The block must exist until the reader
-- function is called again. To signal the end of the chunk, the reader
-- must return @NULL@ or set size to zero. The reader function may
-- return pieces of any size greater than zero.
--
-- See <https://www.lua.org/manual/5.3/manual.html#lua_Reader lua_Reader>.
type Reader = FunPtr (State -> Ptr () -> Ptr CSize -> IO (Ptr CChar))

-- |  The type of integers in Lua.
--
-- By default this type is @'Int64'@, but that can be changed to different
-- values in lua. (See @LUA_INT_TYPE@ in @luaconf.h@.)
--
-- See <https://www.lua.org/manual/5.3/manual.html#lua_Integer lua_Integer>.
newtype Integer = Integer Int64
{-# LINE 99 "src/Foreign/Lua/Raw/Types.hsc" #-}
  deriving (Bounded, Enum, Eq, Integral, Num, Ord, Real, Show)

-- |  The type of floats in Lua.
--
-- By default this type is @'Double'@, but that can be changed in Lua to a
-- single float or a long double. (See @LUA_FLOAT_TYPE@ in @luaconf.h@.)
--
-- See <https://www.lua.org/manual/5.3/manual.html#lua_Number lua_Number>.
newtype Number = Number Double
{-# LINE 108 "src/Foreign/Lua/Raw/Types.hsc" #-}
  deriving (Eq, Floating, Fractional, Num, Ord, Real, RealFloat, RealFrac, Show)


--
-- LuaBool
--

-- | Boolean value returned by a Lua C API function. This is a @'CInt'@ and
-- interpreted as @'False'@ iff the value is @0@, @'True'@ otherwise.
newtype LuaBool = LuaBool CInt
  deriving (LuaBool -> LuaBool -> Bool
(LuaBool -> LuaBool -> Bool)
-> (LuaBool -> LuaBool -> Bool) -> Eq LuaBool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LuaBool -> LuaBool -> Bool
$c/= :: LuaBool -> LuaBool -> Bool
== :: LuaBool -> LuaBool -> Bool
$c== :: LuaBool -> LuaBool -> Bool
Eq, Ptr b -> Int -> IO LuaBool
Ptr b -> Int -> LuaBool -> IO ()
Ptr LuaBool -> IO LuaBool
Ptr LuaBool -> Int -> IO LuaBool
Ptr LuaBool -> Int -> LuaBool -> IO ()
Ptr LuaBool -> LuaBool -> IO ()
LuaBool -> Int
(LuaBool -> Int)
-> (LuaBool -> Int)
-> (Ptr LuaBool -> Int -> IO LuaBool)
-> (Ptr LuaBool -> Int -> LuaBool -> IO ())
-> (forall b. Ptr b -> Int -> IO LuaBool)
-> (forall b. Ptr b -> Int -> LuaBool -> IO ())
-> (Ptr LuaBool -> IO LuaBool)
-> (Ptr LuaBool -> LuaBool -> IO ())
-> Storable LuaBool
forall b. Ptr b -> Int -> IO LuaBool
forall b. Ptr b -> Int -> LuaBool -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr LuaBool -> LuaBool -> IO ()
$cpoke :: Ptr LuaBool -> LuaBool -> IO ()
peek :: Ptr LuaBool -> IO LuaBool
$cpeek :: Ptr LuaBool -> IO LuaBool
pokeByteOff :: Ptr b -> Int -> LuaBool -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> LuaBool -> IO ()
peekByteOff :: Ptr b -> Int -> IO LuaBool
$cpeekByteOff :: forall b. Ptr b -> Int -> IO LuaBool
pokeElemOff :: Ptr LuaBool -> Int -> LuaBool -> IO ()
$cpokeElemOff :: Ptr LuaBool -> Int -> LuaBool -> IO ()
peekElemOff :: Ptr LuaBool -> Int -> IO LuaBool
$cpeekElemOff :: Ptr LuaBool -> Int -> IO LuaBool
alignment :: LuaBool -> Int
$calignment :: LuaBool -> Int
sizeOf :: LuaBool -> Int
$csizeOf :: LuaBool -> Int
Storable, Int -> LuaBool -> ShowS
[LuaBool] -> ShowS
LuaBool -> String
(Int -> LuaBool -> ShowS)
-> (LuaBool -> String) -> ([LuaBool] -> ShowS) -> Show LuaBool
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LuaBool] -> ShowS
$cshowList :: [LuaBool] -> ShowS
show :: LuaBool -> String
$cshow :: LuaBool -> String
showsPrec :: Int -> LuaBool -> ShowS
$cshowsPrec :: Int -> LuaBool -> ShowS
Show)

-- | Generic Lua representation of a value interpreted as being true.
true :: LuaBool
true :: LuaBool
true = CInt -> LuaBool
LuaBool CInt
1

-- | Lua representation of the value interpreted as false.
false :: LuaBool
false :: LuaBool
false = CInt -> LuaBool
LuaBool CInt
0

-- | Convert a @'LuaBool'@ to a Haskell @'Bool'@.
fromLuaBool :: LuaBool -> Bool
fromLuaBool :: LuaBool -> Bool
fromLuaBool (LuaBool CInt
0) = 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 #-}


--
-- * Type of Lua values
--

-- | Enumeration used as type tag.
-- See <https://www.lua.org/manual/5.3/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)

-- | Integer code used to encode the type of a lua value.
newtype TypeCode = TypeCode { TypeCode -> CInt
fromTypeCode :: CInt }
  deriving (TypeCode -> TypeCode -> Bool
(TypeCode -> TypeCode -> Bool)
-> (TypeCode -> TypeCode -> Bool) -> Eq TypeCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeCode -> TypeCode -> Bool
$c/= :: TypeCode -> TypeCode -> Bool
== :: TypeCode -> TypeCode -> Bool
$c== :: TypeCode -> TypeCode -> Bool
Eq, Eq TypeCode
Eq TypeCode
-> (TypeCode -> TypeCode -> Ordering)
-> (TypeCode -> TypeCode -> Bool)
-> (TypeCode -> TypeCode -> Bool)
-> (TypeCode -> TypeCode -> Bool)
-> (TypeCode -> TypeCode -> Bool)
-> (TypeCode -> TypeCode -> TypeCode)
-> (TypeCode -> TypeCode -> TypeCode)
-> Ord TypeCode
TypeCode -> TypeCode -> Bool
TypeCode -> TypeCode -> Ordering
TypeCode -> TypeCode -> TypeCode
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 :: TypeCode -> TypeCode -> TypeCode
$cmin :: TypeCode -> TypeCode -> TypeCode
max :: TypeCode -> TypeCode -> TypeCode
$cmax :: TypeCode -> TypeCode -> TypeCode
>= :: TypeCode -> TypeCode -> Bool
$c>= :: TypeCode -> TypeCode -> Bool
> :: TypeCode -> TypeCode -> Bool
$c> :: TypeCode -> TypeCode -> Bool
<= :: TypeCode -> TypeCode -> Bool
$c<= :: TypeCode -> TypeCode -> Bool
< :: TypeCode -> TypeCode -> Bool
$c< :: TypeCode -> TypeCode -> Bool
compare :: TypeCode -> TypeCode -> Ordering
$ccompare :: TypeCode -> TypeCode -> Ordering
$cp1Ord :: Eq TypeCode
Ord, Int -> TypeCode -> ShowS
[TypeCode] -> ShowS
TypeCode -> String
(Int -> TypeCode -> ShowS)
-> (TypeCode -> String) -> ([TypeCode] -> ShowS) -> Show TypeCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeCode] -> ShowS
$cshowList :: [TypeCode] -> ShowS
show :: TypeCode -> String
$cshow :: TypeCode -> String
showsPrec :: Int -> TypeCode -> ShowS
$cshowsPrec :: Int -> TypeCode -> 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 Type
tp = CInt -> TypeCode
TypeCode (CInt -> TypeCode) -> CInt -> TypeCode
forall a b. (a -> b) -> a -> b
$ case Type
tp of
  Type
TypeNone          -> -CInt
1
{-# LINE 172 "src/Foreign/Lua/Raw/Types.hsc" #-}
  TypeNil           -> 0
{-# LINE 173 "src/Foreign/Lua/Raw/Types.hsc" #-}
  TypeBoolean       -> 1
{-# LINE 174 "src/Foreign/Lua/Raw/Types.hsc" #-}
  TypeLightUserdata -> 2
{-# LINE 175 "src/Foreign/Lua/Raw/Types.hsc" #-}
  TypeNumber        -> 3
{-# LINE 176 "src/Foreign/Lua/Raw/Types.hsc" #-}
  TypeString        -> 4
{-# LINE 177 "src/Foreign/Lua/Raw/Types.hsc" #-}
  TypeTable         -> 5
{-# LINE 178 "src/Foreign/Lua/Raw/Types.hsc" #-}
  TypeFunction      -> 6
{-# LINE 179 "src/Foreign/Lua/Raw/Types.hsc" #-}
  TypeUserdata      -> 7
{-# LINE 180 "src/Foreign/Lua/Raw/Types.hsc" #-}
  TypeThread        -> 8
{-# LINE 181 "src/Foreign/Lua/Raw/Types.hsc" #-}

-- | Convert numerical code to lua type.
toType :: TypeCode -> Type
toType :: TypeCode -> Type
toType (TypeCode CInt
c) = case CInt
c of
  -1          -> Type
TypeNone
{-# LINE 186 "src/Foreign/Lua/Raw/Types.hsc" #-}
  0           -> TypeNil
{-# LINE 187 "src/Foreign/Lua/Raw/Types.hsc" #-}
  1       -> TypeBoolean
{-# LINE 188 "src/Foreign/Lua/Raw/Types.hsc" #-}
  2 -> TypeLightUserdata
{-# LINE 189 "src/Foreign/Lua/Raw/Types.hsc" #-}
  3        -> TypeNumber
{-# LINE 190 "src/Foreign/Lua/Raw/Types.hsc" #-}
  4        -> TypeString
{-# LINE 191 "src/Foreign/Lua/Raw/Types.hsc" #-}
  5         -> TypeTable
{-# LINE 192 "src/Foreign/Lua/Raw/Types.hsc" #-}
  6      -> TypeFunction
{-# LINE 193 "src/Foreign/Lua/Raw/Types.hsc" #-}
  7      -> TypeUserdata
{-# LINE 194 "src/Foreign/Lua/Raw/Types.hsc" #-}
  8        -> TypeThread
{-# LINE 195 "src/Foreign/Lua/Raw/Types.hsc" #-}
  _ -> error ("No Type corresponding to " ++ show c)

--
-- * 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 -> CInt
fromRelationalOperator :: RelationalOperator -> CInt
fromRelationalOperator RelationalOperator
EQ = CInt
0
{-# LINE 211 "src/Foreign/Lua/Raw/Types.hsc" #-}
fromRelationalOperator LT = 1
{-# LINE 212 "src/Foreign/Lua/Raw/Types.hsc" #-}
fromRelationalOperator LE = 2
{-# LINE 213 "src/Foreign/Lua/Raw/Types.hsc" #-}
{-# INLINABLE fromRelationalOperator #-}


--
-- * 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.
  | ErrGcmm   -- ^ error while running a @__gc@ metamethod.
  | 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 (StatusCode CInt
c) = case CInt
c of
  CInt
0        -> Status
OK
{-# LINE 236 "src/Foreign/Lua/Raw/Types.hsc" #-}
  1     -> Yield
{-# LINE 237 "src/Foreign/Lua/Raw/Types.hsc" #-}
  2    -> ErrRun
{-# LINE 238 "src/Foreign/Lua/Raw/Types.hsc" #-}
  3 -> ErrSyntax
{-# LINE 239 "src/Foreign/Lua/Raw/Types.hsc" #-}
  4    -> ErrMem
{-# LINE 240 "src/Foreign/Lua/Raw/Types.hsc" #-}
  5   -> ErrGcmm
{-# LINE 241 "src/Foreign/Lua/Raw/Types.hsc" #-}
  6    -> ErrErr
{-# LINE 242 "src/Foreign/Lua/Raw/Types.hsc" #-}
  7   -> ErrFile
{-# LINE 243 "src/Foreign/Lua/Raw/Types.hsc" #-}
  n -> error $ "Cannot convert (" ++ show n ++ ") to Status"
{-# INLINABLE toStatus #-}

-- | Integer code used to signal the status of a thread or computation.
-- See @'Status'@.
newtype StatusCode = StatusCode CInt deriving (StatusCode -> StatusCode -> Bool
(StatusCode -> StatusCode -> Bool)
-> (StatusCode -> StatusCode -> Bool) -> Eq StatusCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StatusCode -> StatusCode -> Bool
$c/= :: StatusCode -> StatusCode -> Bool
== :: StatusCode -> StatusCode -> Bool
$c== :: StatusCode -> StatusCode -> Bool
Eq, Ptr b -> Int -> IO StatusCode
Ptr b -> Int -> StatusCode -> IO ()
Ptr StatusCode -> IO StatusCode
Ptr StatusCode -> Int -> IO StatusCode
Ptr StatusCode -> Int -> StatusCode -> IO ()
Ptr StatusCode -> StatusCode -> IO ()
StatusCode -> Int
(StatusCode -> Int)
-> (StatusCode -> Int)
-> (Ptr StatusCode -> Int -> IO StatusCode)
-> (Ptr StatusCode -> Int -> StatusCode -> IO ())
-> (forall b. Ptr b -> Int -> IO StatusCode)
-> (forall b. Ptr b -> Int -> StatusCode -> IO ())
-> (Ptr StatusCode -> IO StatusCode)
-> (Ptr StatusCode -> StatusCode -> IO ())
-> Storable StatusCode
forall b. Ptr b -> Int -> IO StatusCode
forall b. Ptr b -> Int -> StatusCode -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr StatusCode -> StatusCode -> IO ()
$cpoke :: Ptr StatusCode -> StatusCode -> IO ()
peek :: Ptr StatusCode -> IO StatusCode
$cpeek :: Ptr StatusCode -> IO StatusCode
pokeByteOff :: Ptr b -> Int -> StatusCode -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> StatusCode -> IO ()
peekByteOff :: Ptr b -> Int -> IO StatusCode
$cpeekByteOff :: forall b. Ptr b -> Int -> IO StatusCode
pokeElemOff :: Ptr StatusCode -> Int -> StatusCode -> IO ()
$cpokeElemOff :: Ptr StatusCode -> Int -> StatusCode -> IO ()
peekElemOff :: Ptr StatusCode -> Int -> IO StatusCode
$cpeekElemOff :: Ptr StatusCode -> Int -> IO StatusCode
alignment :: StatusCode -> Int
$calignment :: StatusCode -> Int
sizeOf :: StatusCode -> Int
$csizeOf :: StatusCode -> Int
Storable)


--
-- * Gargabe Collection Control
--

-- | Enumeration used by @gc@ function.
data GCCONTROL
  = GCSTOP
  | GCRESTART
  | GCCOLLECT
  | GCCOUNT
  | GCCOUNTB
  | GCSTEP
  | GCSETPAUSE
  | GCSETSTEPMUL
  deriving (Int -> GCCONTROL
GCCONTROL -> Int
GCCONTROL -> [GCCONTROL]
GCCONTROL -> GCCONTROL
GCCONTROL -> GCCONTROL -> [GCCONTROL]
GCCONTROL -> GCCONTROL -> GCCONTROL -> [GCCONTROL]
(GCCONTROL -> GCCONTROL)
-> (GCCONTROL -> GCCONTROL)
-> (Int -> GCCONTROL)
-> (GCCONTROL -> Int)
-> (GCCONTROL -> [GCCONTROL])
-> (GCCONTROL -> GCCONTROL -> [GCCONTROL])
-> (GCCONTROL -> GCCONTROL -> [GCCONTROL])
-> (GCCONTROL -> GCCONTROL -> GCCONTROL -> [GCCONTROL])
-> Enum GCCONTROL
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: GCCONTROL -> GCCONTROL -> GCCONTROL -> [GCCONTROL]
$cenumFromThenTo :: GCCONTROL -> GCCONTROL -> GCCONTROL -> [GCCONTROL]
enumFromTo :: GCCONTROL -> GCCONTROL -> [GCCONTROL]
$cenumFromTo :: GCCONTROL -> GCCONTROL -> [GCCONTROL]
enumFromThen :: GCCONTROL -> GCCONTROL -> [GCCONTROL]
$cenumFromThen :: GCCONTROL -> GCCONTROL -> [GCCONTROL]
enumFrom :: GCCONTROL -> [GCCONTROL]
$cenumFrom :: GCCONTROL -> [GCCONTROL]
fromEnum :: GCCONTROL -> Int
$cfromEnum :: GCCONTROL -> Int
toEnum :: Int -> GCCONTROL
$ctoEnum :: Int -> GCCONTROL
pred :: GCCONTROL -> GCCONTROL
$cpred :: GCCONTROL -> GCCONTROL
succ :: GCCONTROL -> GCCONTROL
$csucc :: GCCONTROL -> GCCONTROL
Enum, 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)

-- | A stack index
newtype StackIndex = StackIndex { StackIndex -> CInt
fromStackIndex :: CInt }
  deriving (Int -> StackIndex
StackIndex -> Int
StackIndex -> [StackIndex]
StackIndex -> StackIndex
StackIndex -> StackIndex -> [StackIndex]
StackIndex -> StackIndex -> StackIndex -> [StackIndex]
(StackIndex -> StackIndex)
-> (StackIndex -> StackIndex)
-> (Int -> StackIndex)
-> (StackIndex -> Int)
-> (StackIndex -> [StackIndex])
-> (StackIndex -> StackIndex -> [StackIndex])
-> (StackIndex -> StackIndex -> [StackIndex])
-> (StackIndex -> StackIndex -> StackIndex -> [StackIndex])
-> Enum StackIndex
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: StackIndex -> StackIndex -> StackIndex -> [StackIndex]
$cenumFromThenTo :: StackIndex -> StackIndex -> StackIndex -> [StackIndex]
enumFromTo :: StackIndex -> StackIndex -> [StackIndex]
$cenumFromTo :: StackIndex -> StackIndex -> [StackIndex]
enumFromThen :: StackIndex -> StackIndex -> [StackIndex]
$cenumFromThen :: StackIndex -> StackIndex -> [StackIndex]
enumFrom :: StackIndex -> [StackIndex]
$cenumFrom :: StackIndex -> [StackIndex]
fromEnum :: StackIndex -> Int
$cfromEnum :: StackIndex -> Int
toEnum :: Int -> StackIndex
$ctoEnum :: Int -> StackIndex
pred :: StackIndex -> StackIndex
$cpred :: StackIndex -> StackIndex
succ :: StackIndex -> StackIndex
$csucc :: StackIndex -> StackIndex
Enum, StackIndex -> StackIndex -> Bool
(StackIndex -> StackIndex -> Bool)
-> (StackIndex -> StackIndex -> Bool) -> Eq StackIndex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StackIndex -> StackIndex -> Bool
$c/= :: StackIndex -> StackIndex -> Bool
== :: StackIndex -> StackIndex -> Bool
$c== :: StackIndex -> StackIndex -> Bool
Eq, Integer -> StackIndex
StackIndex -> StackIndex
StackIndex -> StackIndex -> StackIndex
(StackIndex -> StackIndex -> StackIndex)
-> (StackIndex -> StackIndex -> StackIndex)
-> (StackIndex -> StackIndex -> StackIndex)
-> (StackIndex -> StackIndex)
-> (StackIndex -> StackIndex)
-> (StackIndex -> StackIndex)
-> (Integer -> StackIndex)
-> Num StackIndex
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> StackIndex
$cfromInteger :: Integer -> StackIndex
signum :: StackIndex -> StackIndex
$csignum :: StackIndex -> StackIndex
abs :: StackIndex -> StackIndex
$cabs :: StackIndex -> StackIndex
negate :: StackIndex -> StackIndex
$cnegate :: StackIndex -> StackIndex
* :: StackIndex -> StackIndex -> StackIndex
$c* :: StackIndex -> StackIndex -> StackIndex
- :: StackIndex -> StackIndex -> StackIndex
$c- :: StackIndex -> StackIndex -> StackIndex
+ :: StackIndex -> StackIndex -> StackIndex
$c+ :: StackIndex -> StackIndex -> StackIndex
Num, Eq StackIndex
Eq StackIndex
-> (StackIndex -> StackIndex -> Ordering)
-> (StackIndex -> StackIndex -> Bool)
-> (StackIndex -> StackIndex -> Bool)
-> (StackIndex -> StackIndex -> Bool)
-> (StackIndex -> StackIndex -> Bool)
-> (StackIndex -> StackIndex -> StackIndex)
-> (StackIndex -> StackIndex -> StackIndex)
-> Ord StackIndex
StackIndex -> StackIndex -> Bool
StackIndex -> StackIndex -> Ordering
StackIndex -> StackIndex -> StackIndex
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 :: StackIndex -> StackIndex -> StackIndex
$cmin :: StackIndex -> StackIndex -> StackIndex
max :: StackIndex -> StackIndex -> StackIndex
$cmax :: StackIndex -> StackIndex -> StackIndex
>= :: StackIndex -> StackIndex -> Bool
$c>= :: StackIndex -> StackIndex -> Bool
> :: StackIndex -> StackIndex -> Bool
$c> :: StackIndex -> StackIndex -> Bool
<= :: StackIndex -> StackIndex -> Bool
$c<= :: StackIndex -> StackIndex -> Bool
< :: StackIndex -> StackIndex -> Bool
$c< :: StackIndex -> StackIndex -> Bool
compare :: StackIndex -> StackIndex -> Ordering
$ccompare :: StackIndex -> StackIndex -> Ordering
$cp1Ord :: Eq StackIndex
Ord, Int -> StackIndex -> ShowS
[StackIndex] -> ShowS
StackIndex -> String
(Int -> StackIndex -> ShowS)
-> (StackIndex -> String)
-> ([StackIndex] -> ShowS)
-> Show StackIndex
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StackIndex] -> ShowS
$cshowList :: [StackIndex] -> ShowS
show :: StackIndex -> String
$cshow :: StackIndex -> String
showsPrec :: Int -> StackIndex -> ShowS
$cshowsPrec :: Int -> StackIndex -> ShowS
Show)

--
-- Number of arguments and return values
--

-- | The number of arguments consumed curing a function call.
newtype NumArgs = NumArgs { NumArgs -> CInt
fromNumArgs :: CInt }
  deriving (NumArgs -> NumArgs -> Bool
(NumArgs -> NumArgs -> Bool)
-> (NumArgs -> NumArgs -> Bool) -> Eq NumArgs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NumArgs -> NumArgs -> Bool
$c/= :: NumArgs -> NumArgs -> Bool
== :: NumArgs -> NumArgs -> Bool
$c== :: NumArgs -> NumArgs -> Bool
Eq, Integer -> NumArgs
NumArgs -> NumArgs
NumArgs -> NumArgs -> NumArgs
(NumArgs -> NumArgs -> NumArgs)
-> (NumArgs -> NumArgs -> NumArgs)
-> (NumArgs -> NumArgs -> NumArgs)
-> (NumArgs -> NumArgs)
-> (NumArgs -> NumArgs)
-> (NumArgs -> NumArgs)
-> (Integer -> NumArgs)
-> Num NumArgs
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> NumArgs
$cfromInteger :: Integer -> NumArgs
signum :: NumArgs -> NumArgs
$csignum :: NumArgs -> NumArgs
abs :: NumArgs -> NumArgs
$cabs :: NumArgs -> NumArgs
negate :: NumArgs -> NumArgs
$cnegate :: NumArgs -> NumArgs
* :: NumArgs -> NumArgs -> NumArgs
$c* :: NumArgs -> NumArgs -> NumArgs
- :: NumArgs -> NumArgs -> NumArgs
$c- :: NumArgs -> NumArgs -> NumArgs
+ :: NumArgs -> NumArgs -> NumArgs
$c+ :: NumArgs -> NumArgs -> NumArgs
Num, Eq NumArgs
Eq NumArgs
-> (NumArgs -> NumArgs -> Ordering)
-> (NumArgs -> NumArgs -> Bool)
-> (NumArgs -> NumArgs -> Bool)
-> (NumArgs -> NumArgs -> Bool)
-> (NumArgs -> NumArgs -> Bool)
-> (NumArgs -> NumArgs -> NumArgs)
-> (NumArgs -> NumArgs -> NumArgs)
-> Ord NumArgs
NumArgs -> NumArgs -> Bool
NumArgs -> NumArgs -> Ordering
NumArgs -> NumArgs -> NumArgs
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 :: NumArgs -> NumArgs -> NumArgs
$cmin :: NumArgs -> NumArgs -> NumArgs
max :: NumArgs -> NumArgs -> NumArgs
$cmax :: NumArgs -> NumArgs -> NumArgs
>= :: NumArgs -> NumArgs -> Bool
$c>= :: NumArgs -> NumArgs -> Bool
> :: NumArgs -> NumArgs -> Bool
$c> :: NumArgs -> NumArgs -> Bool
<= :: NumArgs -> NumArgs -> Bool
$c<= :: NumArgs -> NumArgs -> Bool
< :: NumArgs -> NumArgs -> Bool
$c< :: NumArgs -> NumArgs -> Bool
compare :: NumArgs -> NumArgs -> Ordering
$ccompare :: NumArgs -> NumArgs -> Ordering
$cp1Ord :: Eq NumArgs
Ord, Int -> NumArgs -> ShowS
[NumArgs] -> ShowS
NumArgs -> String
(Int -> NumArgs -> ShowS)
-> (NumArgs -> String) -> ([NumArgs] -> ShowS) -> Show NumArgs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NumArgs] -> ShowS
$cshowList :: [NumArgs] -> ShowS
show :: NumArgs -> String
$cshow :: NumArgs -> String
showsPrec :: Int -> NumArgs -> ShowS
$cshowsPrec :: Int -> NumArgs -> ShowS
Show)

-- | The number of results returned by a function call.
newtype NumResults = NumResults { NumResults -> CInt
fromNumResults :: CInt }
  deriving (NumResults -> NumResults -> Bool
(NumResults -> NumResults -> Bool)
-> (NumResults -> NumResults -> Bool) -> Eq NumResults
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NumResults -> NumResults -> Bool
$c/= :: NumResults -> NumResults -> Bool
== :: NumResults -> NumResults -> Bool
$c== :: NumResults -> NumResults -> Bool
Eq, Integer -> NumResults
NumResults -> NumResults
NumResults -> NumResults -> NumResults
(NumResults -> NumResults -> NumResults)
-> (NumResults -> NumResults -> NumResults)
-> (NumResults -> NumResults -> NumResults)
-> (NumResults -> NumResults)
-> (NumResults -> NumResults)
-> (NumResults -> NumResults)
-> (Integer -> NumResults)
-> Num NumResults
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> NumResults
$cfromInteger :: Integer -> NumResults
signum :: NumResults -> NumResults
$csignum :: NumResults -> NumResults
abs :: NumResults -> NumResults
$cabs :: NumResults -> NumResults
negate :: NumResults -> NumResults
$cnegate :: NumResults -> NumResults
* :: NumResults -> NumResults -> NumResults
$c* :: NumResults -> NumResults -> NumResults
- :: NumResults -> NumResults -> NumResults
$c- :: NumResults -> NumResults -> NumResults
+ :: NumResults -> NumResults -> NumResults
$c+ :: NumResults -> NumResults -> NumResults
Num, Eq NumResults
Eq NumResults
-> (NumResults -> NumResults -> Ordering)
-> (NumResults -> NumResults -> Bool)
-> (NumResults -> NumResults -> Bool)
-> (NumResults -> NumResults -> Bool)
-> (NumResults -> NumResults -> Bool)
-> (NumResults -> NumResults -> NumResults)
-> (NumResults -> NumResults -> NumResults)
-> Ord NumResults
NumResults -> NumResults -> Bool
NumResults -> NumResults -> Ordering
NumResults -> NumResults -> NumResults
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 :: NumResults -> NumResults -> NumResults
$cmin :: NumResults -> NumResults -> NumResults
max :: NumResults -> NumResults -> NumResults
$cmax :: NumResults -> NumResults -> NumResults
>= :: NumResults -> NumResults -> Bool
$c>= :: NumResults -> NumResults -> Bool
> :: NumResults -> NumResults -> Bool
$c> :: NumResults -> NumResults -> Bool
<= :: NumResults -> NumResults -> Bool
$c<= :: NumResults -> NumResults -> Bool
< :: NumResults -> NumResults -> Bool
$c< :: NumResults -> NumResults -> Bool
compare :: NumResults -> NumResults -> Ordering
$ccompare :: NumResults -> NumResults -> Ordering
$cp1Ord :: Eq NumResults
Ord, Int -> NumResults -> ShowS
[NumResults] -> ShowS
NumResults -> String
(Int -> NumResults -> ShowS)
-> (NumResults -> String)
-> ([NumResults] -> ShowS)
-> Show NumResults
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NumResults] -> ShowS
$cshowList :: [NumResults] -> ShowS
show :: NumResults -> String
$cshow :: NumResults -> String
showsPrec :: Int -> NumResults -> ShowS
$cshowsPrec :: Int -> NumResults -> ShowS
Show)