-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria

#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif

module GI.GIRepository.Enums
    ( 

 -- * Enumerations
-- ** ArrayType #enum:ArrayType#

    ArrayType(..)                           ,


-- ** Direction #enum:Direction#

    Direction(..)                           ,


-- ** InfoType #enum:InfoType#

    InfoType(..)                            ,


-- ** NvokeError #enum:NvokeError#

    NvokeError(..)                          ,


-- ** RepositoryError #enum:RepositoryError#

    RepositoryError(..)                     ,


-- ** ScopeType #enum:ScopeType#

    ScopeType(..)                           ,


-- ** Transfer #enum:Transfer#

    Transfer(..)                            ,


-- ** TypeTag #enum:TypeTag#

    TypeTag(..)                             ,




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL


-- Enum nvokeError
-- | An error occuring while invoking a function via
-- @/g_function_info_invoke()/@.
data NvokeError = 
      NvokeErrorFailed
    -- ^ invokation failed, unknown error.
    | NvokeErrorSymbolNotFound
    -- ^ symbol couldn\'t be found in any of the
    -- libraries associated with the typelib of the function.
    | NvokeErrorArgumentMismatch
    -- ^ the arguments provided didn\'t match
    -- the expected arguments for the functions type signature.
    | AnotherNvokeError Int
    -- ^ Catch-all for unknown values
    deriving (Int -> NvokeError -> ShowS
[NvokeError] -> ShowS
NvokeError -> String
(Int -> NvokeError -> ShowS)
-> (NvokeError -> String)
-> ([NvokeError] -> ShowS)
-> Show NvokeError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NvokeError] -> ShowS
$cshowList :: [NvokeError] -> ShowS
show :: NvokeError -> String
$cshow :: NvokeError -> String
showsPrec :: Int -> NvokeError -> ShowS
$cshowsPrec :: Int -> NvokeError -> ShowS
Show, NvokeError -> NvokeError -> Bool
(NvokeError -> NvokeError -> Bool)
-> (NvokeError -> NvokeError -> Bool) -> Eq NvokeError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NvokeError -> NvokeError -> Bool
$c/= :: NvokeError -> NvokeError -> Bool
== :: NvokeError -> NvokeError -> Bool
$c== :: NvokeError -> NvokeError -> Bool
Eq)

instance P.Enum NvokeError where
    fromEnum :: NvokeError -> Int
fromEnum NvokeErrorFailed = 0
    fromEnum NvokeErrorSymbolNotFound = 1
    fromEnum NvokeErrorArgumentMismatch = 2
    fromEnum (AnotherNvokeError k :: Int
k) = Int
k

    toEnum :: Int -> NvokeError
toEnum 0 = NvokeError
NvokeErrorFailed
    toEnum 1 = NvokeError
NvokeErrorSymbolNotFound
    toEnum 2 = NvokeError
NvokeErrorArgumentMismatch
    toEnum k :: Int
k = Int -> NvokeError
AnotherNvokeError Int
k

instance P.Ord NvokeError where
    compare :: NvokeError -> NvokeError -> Ordering
compare a :: NvokeError
a b :: NvokeError
b = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
P.compare (NvokeError -> Int
forall a. Enum a => a -> Int
P.fromEnum NvokeError
a) (NvokeError -> Int
forall a. Enum a => a -> Int
P.fromEnum NvokeError
b)

-- Enum TypeTag
-- | The type tag of a @/GITypeInfo/@.
data TypeTag = 
      TypeTagVoid
    -- ^ void
    | TypeTagBoolean
    -- ^ boolean
    | TypeTagInt8
    -- ^ 8-bit signed integer
    | TypeTagUint8
    -- ^ 8-bit unsigned integer
    | TypeTagInt16
    -- ^ 16-bit signed integer
    | TypeTagUint16
    -- ^ 16-bit unsigned integer
    | TypeTagInt32
    -- ^ 32-bit signed integer
    | TypeTagUint32
    -- ^ 32-bit unsigned integer
    | TypeTagInt64
    -- ^ 64-bit signed integer
    | TypeTagUint64
    -- ^ 64-bit unsigned integer
    | TypeTagFloat
    -- ^ float
    | TypeTagDouble
    -- ^ double floating point
    | TypeTagGtype
    -- ^ a t'GType'
    | TypeTagUtf8
    -- ^ a UTF-8 encoded string
    | TypeTagFilename
    -- ^ a filename, encoded in the same encoding
    --   as the native filesystem is using.
    | TypeTagArray
    -- ^ an array
    | TypeTagInterface
    -- ^ an extended interface object
    | TypeTagGlist
    -- ^ a t'GI.GLib.Structs.List.List'
    | TypeTagGslist
    -- ^ a t'GI.GLib.Structs.SList.SList'
    | TypeTagGhash
    -- ^ a t'GI.GLib.Structs.HashTable.HashTable'
    | TypeTagError
    -- ^ a t'GError'
    | TypeTagUnichar
    -- ^ Unicode character
    | AnotherTypeTag Int
    -- ^ Catch-all for unknown values
    deriving (Int -> TypeTag -> ShowS
[TypeTag] -> ShowS
TypeTag -> String
(Int -> TypeTag -> ShowS)
-> (TypeTag -> String) -> ([TypeTag] -> ShowS) -> Show TypeTag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeTag] -> ShowS
$cshowList :: [TypeTag] -> ShowS
show :: TypeTag -> String
$cshow :: TypeTag -> String
showsPrec :: Int -> TypeTag -> ShowS
$cshowsPrec :: Int -> TypeTag -> ShowS
Show, TypeTag -> TypeTag -> Bool
(TypeTag -> TypeTag -> Bool)
-> (TypeTag -> TypeTag -> Bool) -> Eq TypeTag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeTag -> TypeTag -> Bool
$c/= :: TypeTag -> TypeTag -> Bool
== :: TypeTag -> TypeTag -> Bool
$c== :: TypeTag -> TypeTag -> Bool
Eq)

instance P.Enum TypeTag where
    fromEnum :: TypeTag -> Int
fromEnum TypeTagVoid = 0
    fromEnum TypeTagBoolean = 1
    fromEnum TypeTagInt8 = 2
    fromEnum TypeTagUint8 = 3
    fromEnum TypeTagInt16 = 4
    fromEnum TypeTagUint16 = 5
    fromEnum TypeTagInt32 = 6
    fromEnum TypeTagUint32 = 7
    fromEnum TypeTagInt64 = 8
    fromEnum TypeTagUint64 = 9
    fromEnum TypeTagFloat = 10
    fromEnum TypeTagDouble = 11
    fromEnum TypeTagGtype = 12
    fromEnum TypeTagUtf8 = 13
    fromEnum TypeTagFilename = 14
    fromEnum TypeTagArray = 15
    fromEnum TypeTagInterface = 16
    fromEnum TypeTagGlist = 17
    fromEnum TypeTagGslist = 18
    fromEnum TypeTagGhash = 19
    fromEnum TypeTagError = 20
    fromEnum TypeTagUnichar = 21
    fromEnum (AnotherTypeTag k :: Int
k) = Int
k

    toEnum :: Int -> TypeTag
toEnum 0 = TypeTag
TypeTagVoid
    toEnum 1 = TypeTag
TypeTagBoolean
    toEnum 2 = TypeTag
TypeTagInt8
    toEnum 3 = TypeTag
TypeTagUint8
    toEnum 4 = TypeTag
TypeTagInt16
    toEnum 5 = TypeTag
TypeTagUint16
    toEnum 6 = TypeTag
TypeTagInt32
    toEnum 7 = TypeTag
TypeTagUint32
    toEnum 8 = TypeTag
TypeTagInt64
    toEnum 9 = TypeTag
TypeTagUint64
    toEnum 10 = TypeTag
TypeTagFloat
    toEnum 11 = TypeTag
TypeTagDouble
    toEnum 12 = TypeTag
TypeTagGtype
    toEnum 13 = TypeTag
TypeTagUtf8
    toEnum 14 = TypeTag
TypeTagFilename
    toEnum 15 = TypeTag
TypeTagArray
    toEnum 16 = TypeTag
TypeTagInterface
    toEnum 17 = TypeTag
TypeTagGlist
    toEnum 18 = TypeTag
TypeTagGslist
    toEnum 19 = TypeTag
TypeTagGhash
    toEnum 20 = TypeTag
TypeTagError
    toEnum 21 = TypeTag
TypeTagUnichar
    toEnum k :: Int
k = Int -> TypeTag
AnotherTypeTag Int
k

instance P.Ord TypeTag where
    compare :: TypeTag -> TypeTag -> Ordering
compare a :: TypeTag
a b :: TypeTag
b = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
P.compare (TypeTag -> Int
forall a. Enum a => a -> Int
P.fromEnum TypeTag
a) (TypeTag -> Int
forall a. Enum a => a -> Int
P.fromEnum TypeTag
b)

-- Enum Transfer
-- | The transfer is the exchange of data between two parts, from the callee to
-- the caller. The callee is either a function\/method\/signal or an
-- object\/interface where a property is defined. The caller is the side
-- accessing a property or calling a function.
-- t'GI.GIRepository.Enums.Transfer' specifies who\'s responsible for freeing the resources after the
-- ownership transfer is complete. In case of a containing type such as a list,
-- an array or a hash table the container itself is specified differently from
-- the items within the container itself. Each container is freed differently,
-- check the documentation for the types themselves for information on how to
-- free them.
data Transfer = 
      TransferNothing
    -- ^ transfer nothing from the callee (function or the type
    -- instance the property belongs to) to the caller. The callee retains the
    -- ownership of the transfer and the caller doesn\'t need to do anything to free
    -- up the resources of this transfer.
    | TransferContainer
    -- ^ transfer the container (list, array, hash table) from
    -- the callee to the caller. The callee retains the ownership of the individual
    -- items in the container and the caller has to free up the container resources
    -- (@/g_list_free()/@\/'GI.GLib.Functions.hashTableDestroy' etc) of this transfer.
    | TransferEverything
    -- ^ transfer everything, eg the container and its
    -- contents from the callee to the caller. This is the case when the callee
    -- creates a copy of all the data it returns. The caller is responsible for
    -- cleaning up the container and item resources of this transfer.
    | AnotherTransfer Int
    -- ^ Catch-all for unknown values
    deriving (Int -> Transfer -> ShowS
[Transfer] -> ShowS
Transfer -> String
(Int -> Transfer -> ShowS)
-> (Transfer -> String) -> ([Transfer] -> ShowS) -> Show Transfer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Transfer] -> ShowS
$cshowList :: [Transfer] -> ShowS
show :: Transfer -> String
$cshow :: Transfer -> String
showsPrec :: Int -> Transfer -> ShowS
$cshowsPrec :: Int -> Transfer -> ShowS
Show, Transfer -> Transfer -> Bool
(Transfer -> Transfer -> Bool)
-> (Transfer -> Transfer -> Bool) -> Eq Transfer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Transfer -> Transfer -> Bool
$c/= :: Transfer -> Transfer -> Bool
== :: Transfer -> Transfer -> Bool
$c== :: Transfer -> Transfer -> Bool
Eq)

instance P.Enum Transfer where
    fromEnum :: Transfer -> Int
fromEnum TransferNothing = 0
    fromEnum TransferContainer = 1
    fromEnum TransferEverything = 2
    fromEnum (AnotherTransfer k :: Int
k) = Int
k

    toEnum :: Int -> Transfer
toEnum 0 = Transfer
TransferNothing
    toEnum 1 = Transfer
TransferContainer
    toEnum 2 = Transfer
TransferEverything
    toEnum k :: Int
k = Int -> Transfer
AnotherTransfer Int
k

instance P.Ord Transfer where
    compare :: Transfer -> Transfer -> Ordering
compare a :: Transfer
a b :: Transfer
b = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
P.compare (Transfer -> Int
forall a. Enum a => a -> Int
P.fromEnum Transfer
a) (Transfer -> Int
forall a. Enum a => a -> Int
P.fromEnum Transfer
b)

-- Enum ScopeType
-- | Scope type of a @/GIArgInfo/@ representing callback, determines how the
-- callback is invoked and is used to decided when the invoke structs
-- can be freed.
data ScopeType = 
      ScopeTypeInvalid
    -- ^ The argument is not of callback type.
    | ScopeTypeCall
    -- ^ The callback and associated user_data is only
    -- used during the call to this function.
    | ScopeTypeAsync
    -- ^ The callback and associated user_data is
    -- only used until the callback is invoked, and the callback.
    -- is invoked always exactly once.
    | ScopeTypeNotified
    -- ^ The callback and and associated
    -- user_data is used until the caller is notfied via the destroy_notify.
    | AnotherScopeType Int
    -- ^ Catch-all for unknown values
    deriving (Int -> ScopeType -> ShowS
[ScopeType] -> ShowS
ScopeType -> String
(Int -> ScopeType -> ShowS)
-> (ScopeType -> String)
-> ([ScopeType] -> ShowS)
-> Show ScopeType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScopeType] -> ShowS
$cshowList :: [ScopeType] -> ShowS
show :: ScopeType -> String
$cshow :: ScopeType -> String
showsPrec :: Int -> ScopeType -> ShowS
$cshowsPrec :: Int -> ScopeType -> ShowS
Show, ScopeType -> ScopeType -> Bool
(ScopeType -> ScopeType -> Bool)
-> (ScopeType -> ScopeType -> Bool) -> Eq ScopeType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScopeType -> ScopeType -> Bool
$c/= :: ScopeType -> ScopeType -> Bool
== :: ScopeType -> ScopeType -> Bool
$c== :: ScopeType -> ScopeType -> Bool
Eq)

instance P.Enum ScopeType where
    fromEnum :: ScopeType -> Int
fromEnum ScopeTypeInvalid = 0
    fromEnum ScopeTypeCall = 1
    fromEnum ScopeTypeAsync = 2
    fromEnum ScopeTypeNotified = 3
    fromEnum (AnotherScopeType k :: Int
k) = Int
k

    toEnum :: Int -> ScopeType
toEnum 0 = ScopeType
ScopeTypeInvalid
    toEnum 1 = ScopeType
ScopeTypeCall
    toEnum 2 = ScopeType
ScopeTypeAsync
    toEnum 3 = ScopeType
ScopeTypeNotified
    toEnum k :: Int
k = Int -> ScopeType
AnotherScopeType Int
k

instance P.Ord ScopeType where
    compare :: ScopeType -> ScopeType -> Ordering
compare a :: ScopeType
a b :: ScopeType
b = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
P.compare (ScopeType -> Int
forall a. Enum a => a -> Int
P.fromEnum ScopeType
a) (ScopeType -> Int
forall a. Enum a => a -> Int
P.fromEnum ScopeType
b)

-- Enum RepositoryError
-- | An error code used with @/G_IREPOSITORY_ERROR/@ in a t'GError' returned
-- from a t'GI.GIRepository.Objects.Repository.Repository' routine.
data RepositoryError = 
      RepositoryErrorTypelibNotFound
    -- ^ the typelib could not be found.
    | RepositoryErrorNamespaceMismatch
    -- ^ the namespace does not match the
    --   requested namespace.
    | RepositoryErrorNamespaceVersionConflict
    -- ^ the version of the
    --   typelib does not match the requested version.
    | RepositoryErrorLibraryNotFound
    -- ^ the library used by the typelib
    --   could not be found.
    | AnotherRepositoryError Int
    -- ^ Catch-all for unknown values
    deriving (Int -> RepositoryError -> ShowS
[RepositoryError] -> ShowS
RepositoryError -> String
(Int -> RepositoryError -> ShowS)
-> (RepositoryError -> String)
-> ([RepositoryError] -> ShowS)
-> Show RepositoryError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RepositoryError] -> ShowS
$cshowList :: [RepositoryError] -> ShowS
show :: RepositoryError -> String
$cshow :: RepositoryError -> String
showsPrec :: Int -> RepositoryError -> ShowS
$cshowsPrec :: Int -> RepositoryError -> ShowS
Show, RepositoryError -> RepositoryError -> Bool
(RepositoryError -> RepositoryError -> Bool)
-> (RepositoryError -> RepositoryError -> Bool)
-> Eq RepositoryError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RepositoryError -> RepositoryError -> Bool
$c/= :: RepositoryError -> RepositoryError -> Bool
== :: RepositoryError -> RepositoryError -> Bool
$c== :: RepositoryError -> RepositoryError -> Bool
Eq)

instance P.Enum RepositoryError where
    fromEnum :: RepositoryError -> Int
fromEnum RepositoryErrorTypelibNotFound = 0
    fromEnum RepositoryErrorNamespaceMismatch = 1
    fromEnum RepositoryErrorNamespaceVersionConflict = 2
    fromEnum RepositoryErrorLibraryNotFound = 3
    fromEnum (AnotherRepositoryError k :: Int
k) = Int
k

    toEnum :: Int -> RepositoryError
toEnum 0 = RepositoryError
RepositoryErrorTypelibNotFound
    toEnum 1 = RepositoryError
RepositoryErrorNamespaceMismatch
    toEnum 2 = RepositoryError
RepositoryErrorNamespaceVersionConflict
    toEnum 3 = RepositoryError
RepositoryErrorLibraryNotFound
    toEnum k :: Int
k = Int -> RepositoryError
AnotherRepositoryError Int
k

instance P.Ord RepositoryError where
    compare :: RepositoryError -> RepositoryError -> Ordering
compare a :: RepositoryError
a b :: RepositoryError
b = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
P.compare (RepositoryError -> Int
forall a. Enum a => a -> Int
P.fromEnum RepositoryError
a) (RepositoryError -> Int
forall a. Enum a => a -> Int
P.fromEnum RepositoryError
b)

-- Enum InfoType
-- | The type of a GIBaseInfo struct.
data InfoType = 
      InfoTypeInvalid
    -- ^ invalid type
    | InfoTypeFunction
    -- ^ function, see @/GIFunctionInfo/@
    | InfoTypeCallback
    -- ^ callback, see @/GIFunctionInfo/@
    | InfoTypeStruct
    -- ^ struct, see @/GIStructInfo/@
    | InfoTypeBoxed
    -- ^ boxed, see @/GIStructInfo/@ or @/GIUnionInfo/@
    | InfoTypeEnum
    -- ^ enum, see @/GIEnumInfo/@
    | InfoTypeFlags
    -- ^ flags, see @/GIEnumInfo/@
    | InfoTypeObject
    -- ^ object, see @/GIObjectInfo/@
    | InfoTypeInterface
    -- ^ interface, see @/GIInterfaceInfo/@
    | InfoTypeConstant
    -- ^ contant, see @/GIConstantInfo/@
    | InfoTypeInvalid0
    -- ^ deleted, used to be GI_INFO_TYPE_ERROR_DOMAIN.
    | InfoTypeUnion
    -- ^ union, see @/GIUnionInfo/@
    | InfoTypeValue
    -- ^ enum value, see @/GIValueInfo/@
    | InfoTypeSignal
    -- ^ signal, see @/GISignalInfo/@
    | InfoTypeVfunc
    -- ^ virtual function, see @/GIVFuncInfo/@
    | InfoTypeProperty
    -- ^ GObject property, see @/GIPropertyInfo/@
    | InfoTypeField
    -- ^ struct or union field, see @/GIFieldInfo/@
    | InfoTypeArg
    -- ^ argument of a function or callback, see @/GIArgInfo/@
    | InfoTypeType
    -- ^ type information, see @/GITypeInfo/@
    | InfoTypeUnresolved
    -- ^ unresolved type, a type which is not present in
    --   the typelib, or any of its dependencies.
    | AnotherInfoType Int
    -- ^ Catch-all for unknown values
    deriving (Int -> InfoType -> ShowS
[InfoType] -> ShowS
InfoType -> String
(Int -> InfoType -> ShowS)
-> (InfoType -> String) -> ([InfoType] -> ShowS) -> Show InfoType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InfoType] -> ShowS
$cshowList :: [InfoType] -> ShowS
show :: InfoType -> String
$cshow :: InfoType -> String
showsPrec :: Int -> InfoType -> ShowS
$cshowsPrec :: Int -> InfoType -> ShowS
Show, InfoType -> InfoType -> Bool
(InfoType -> InfoType -> Bool)
-> (InfoType -> InfoType -> Bool) -> Eq InfoType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InfoType -> InfoType -> Bool
$c/= :: InfoType -> InfoType -> Bool
== :: InfoType -> InfoType -> Bool
$c== :: InfoType -> InfoType -> Bool
Eq)

instance P.Enum InfoType where
    fromEnum :: InfoType -> Int
fromEnum InfoTypeInvalid = 0
    fromEnum InfoTypeFunction = 1
    fromEnum InfoTypeCallback = 2
    fromEnum InfoTypeStruct = 3
    fromEnum InfoTypeBoxed = 4
    fromEnum InfoTypeEnum = 5
    fromEnum InfoTypeFlags = 6
    fromEnum InfoTypeObject = 7
    fromEnum InfoTypeInterface = 8
    fromEnum InfoTypeConstant = 9
    fromEnum InfoTypeInvalid0 = 10
    fromEnum InfoTypeUnion = 11
    fromEnum InfoTypeValue = 12
    fromEnum InfoTypeSignal = 13
    fromEnum InfoTypeVfunc = 14
    fromEnum InfoTypeProperty = 15
    fromEnum InfoTypeField = 16
    fromEnum InfoTypeArg = 17
    fromEnum InfoTypeType = 18
    fromEnum InfoTypeUnresolved = 19
    fromEnum (AnotherInfoType k :: Int
k) = Int
k

    toEnum :: Int -> InfoType
toEnum 0 = InfoType
InfoTypeInvalid
    toEnum 1 = InfoType
InfoTypeFunction
    toEnum 2 = InfoType
InfoTypeCallback
    toEnum 3 = InfoType
InfoTypeStruct
    toEnum 4 = InfoType
InfoTypeBoxed
    toEnum 5 = InfoType
InfoTypeEnum
    toEnum 6 = InfoType
InfoTypeFlags
    toEnum 7 = InfoType
InfoTypeObject
    toEnum 8 = InfoType
InfoTypeInterface
    toEnum 9 = InfoType
InfoTypeConstant
    toEnum 10 = InfoType
InfoTypeInvalid0
    toEnum 11 = InfoType
InfoTypeUnion
    toEnum 12 = InfoType
InfoTypeValue
    toEnum 13 = InfoType
InfoTypeSignal
    toEnum 14 = InfoType
InfoTypeVfunc
    toEnum 15 = InfoType
InfoTypeProperty
    toEnum 16 = InfoType
InfoTypeField
    toEnum 17 = InfoType
InfoTypeArg
    toEnum 18 = InfoType
InfoTypeType
    toEnum 19 = InfoType
InfoTypeUnresolved
    toEnum k :: Int
k = Int -> InfoType
AnotherInfoType Int
k

instance P.Ord InfoType where
    compare :: InfoType -> InfoType -> Ordering
compare a :: InfoType
a b :: InfoType
b = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
P.compare (InfoType -> Int
forall a. Enum a => a -> Int
P.fromEnum InfoType
a) (InfoType -> Int
forall a. Enum a => a -> Int
P.fromEnum InfoType
b)

-- Enum Direction
-- | The direction of a @/GIArgInfo/@.
data Direction = 
      DirectionIn
    -- ^ in argument.
    | DirectionOut
    -- ^ out argument.
    | DirectionInout
    -- ^ in and out argument.
    | AnotherDirection Int
    -- ^ Catch-all for unknown values
    deriving (Int -> Direction -> ShowS
[Direction] -> ShowS
Direction -> String
(Int -> Direction -> ShowS)
-> (Direction -> String)
-> ([Direction] -> ShowS)
-> Show Direction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Direction] -> ShowS
$cshowList :: [Direction] -> ShowS
show :: Direction -> String
$cshow :: Direction -> String
showsPrec :: Int -> Direction -> ShowS
$cshowsPrec :: Int -> Direction -> ShowS
Show, Direction -> Direction -> Bool
(Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool) -> Eq Direction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Direction -> Direction -> Bool
$c/= :: Direction -> Direction -> Bool
== :: Direction -> Direction -> Bool
$c== :: Direction -> Direction -> Bool
Eq)

instance P.Enum Direction where
    fromEnum :: Direction -> Int
fromEnum DirectionIn = 0
    fromEnum DirectionOut = 1
    fromEnum DirectionInout = 2
    fromEnum (AnotherDirection k :: Int
k) = Int
k

    toEnum :: Int -> Direction
toEnum 0 = Direction
DirectionIn
    toEnum 1 = Direction
DirectionOut
    toEnum 2 = Direction
DirectionInout
    toEnum k :: Int
k = Int -> Direction
AnotherDirection Int
k

instance P.Ord Direction where
    compare :: Direction -> Direction -> Ordering
compare a :: Direction
a b :: Direction
b = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
P.compare (Direction -> Int
forall a. Enum a => a -> Int
P.fromEnum Direction
a) (Direction -> Int
forall a. Enum a => a -> Int
P.fromEnum Direction
b)

-- Enum ArrayType
-- | The type of array in a @/GITypeInfo/@.
data ArrayType = 
      ArrayTypeC
    -- ^ a C array, char[] for instance
    | ArrayTypeArray
    -- ^ a /@gArray@/ array
    | ArrayTypePtrArray
    -- ^ a t'GI.GLib.Structs.PtrArray.PtrArray' array
    | ArrayTypeByteArray
    -- ^ a t'GI.GLib.Structs.ByteArray.ByteArray' array
    | AnotherArrayType Int
    -- ^ Catch-all for unknown values
    deriving (Int -> ArrayType -> ShowS
[ArrayType] -> ShowS
ArrayType -> String
(Int -> ArrayType -> ShowS)
-> (ArrayType -> String)
-> ([ArrayType] -> ShowS)
-> Show ArrayType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ArrayType] -> ShowS
$cshowList :: [ArrayType] -> ShowS
show :: ArrayType -> String
$cshow :: ArrayType -> String
showsPrec :: Int -> ArrayType -> ShowS
$cshowsPrec :: Int -> ArrayType -> ShowS
Show, ArrayType -> ArrayType -> Bool
(ArrayType -> ArrayType -> Bool)
-> (ArrayType -> ArrayType -> Bool) -> Eq ArrayType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArrayType -> ArrayType -> Bool
$c/= :: ArrayType -> ArrayType -> Bool
== :: ArrayType -> ArrayType -> Bool
$c== :: ArrayType -> ArrayType -> Bool
Eq)

instance P.Enum ArrayType where
    fromEnum :: ArrayType -> Int
fromEnum ArrayTypeC = 0
    fromEnum ArrayTypeArray = 1
    fromEnum ArrayTypePtrArray = 2
    fromEnum ArrayTypeByteArray = 3
    fromEnum (AnotherArrayType k :: Int
k) = Int
k

    toEnum :: Int -> ArrayType
toEnum 0 = ArrayType
ArrayTypeC
    toEnum 1 = ArrayType
ArrayTypeArray
    toEnum 2 = ArrayType
ArrayTypePtrArray
    toEnum 3 = ArrayType
ArrayTypeByteArray
    toEnum k :: Int
k = Int -> ArrayType
AnotherArrayType Int
k

instance P.Ord ArrayType where
    compare :: ArrayType -> ArrayType -> Ordering
compare a :: ArrayType
a b :: ArrayType
b = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
P.compare (ArrayType -> Int
forall a. Enum a => a -> Int
P.fromEnum ArrayType
a) (ArrayType -> Int
forall a. Enum a => a -> Int
P.fromEnum ArrayType
b)