-- | 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.Gst.Enums
    ( 

 -- * Enumerations
-- ** BufferingMode #enum:BufferingMode#

    BufferingMode(..)                       ,


-- ** BusSyncReply #enum:BusSyncReply#

    BusSyncReply(..)                        ,


-- ** CapsIntersectMode #enum:CapsIntersectMode#

    CapsIntersectMode(..)                   ,


-- ** ClockEntryType #enum:ClockEntryType#

    ClockEntryType(..)                      ,


-- ** ClockReturn #enum:ClockReturn#

    ClockReturn(..)                         ,


-- ** ClockType #enum:ClockType#

    ClockType(..)                           ,


-- ** CoreError #enum:CoreError#

    CoreError(..)                           ,
    catchCoreError                          ,
    handleCoreError                         ,


-- ** DebugColorMode #enum:DebugColorMode#

    DebugColorMode(..)                      ,


-- ** DebugLevel #enum:DebugLevel#

    DebugLevel(..)                          ,


-- ** EventType #enum:EventType#

    EventType(..)                           ,


-- ** FlowReturn #enum:FlowReturn#

    FlowReturn(..)                          ,


-- ** Format #enum:Format#

    Format(..)                              ,


-- ** IteratorItem #enum:IteratorItem#

    IteratorItem(..)                        ,


-- ** IteratorResult #enum:IteratorResult#

    IteratorResult(..)                      ,


-- ** LibraryError #enum:LibraryError#

    LibraryError(..)                        ,
    catchLibraryError                       ,
    handleLibraryError                      ,


-- ** PadDirection #enum:PadDirection#

    PadDirection(..)                        ,


-- ** PadLinkReturn #enum:PadLinkReturn#

    PadLinkReturn(..)                       ,


-- ** PadMode #enum:PadMode#

    PadMode(..)                             ,


-- ** PadPresence #enum:PadPresence#

    PadPresence(..)                         ,


-- ** PadProbeReturn #enum:PadProbeReturn#

    PadProbeReturn(..)                      ,


-- ** ParseError #enum:ParseError#

    ParseError(..)                          ,
    catchParseError                         ,
    handleParseError                        ,


-- ** PluginError #enum:PluginError#

    PluginError(..)                         ,
    catchPluginError                        ,
    handlePluginError                       ,


-- ** ProgressType #enum:ProgressType#

    ProgressType(..)                        ,


-- ** PromiseResult #enum:PromiseResult#

    PromiseResult(..)                       ,


-- ** QOSType #enum:QOSType#

    QOSType(..)                             ,


-- ** QueryType #enum:QueryType#

    QueryType(..)                           ,


-- ** Rank #enum:Rank#

    Rank(..)                                ,


-- ** ResourceError #enum:ResourceError#

    ResourceError(..)                       ,
    catchResourceError                      ,
    handleResourceError                     ,


-- ** SearchMode #enum:SearchMode#

    SearchMode(..)                          ,


-- ** SeekType #enum:SeekType#

    SeekType(..)                            ,


-- ** State #enum:State#

    State(..)                               ,


-- ** StateChange #enum:StateChange#

    StateChange(..)                         ,


-- ** StateChangeReturn #enum:StateChangeReturn#

    StateChangeReturn(..)                   ,


-- ** StreamError #enum:StreamError#

    StreamError(..)                         ,
    catchStreamError                        ,
    handleStreamError                       ,


-- ** StreamStatusType #enum:StreamStatusType#

    StreamStatusType(..)                    ,


-- ** StructureChangeType #enum:StructureChangeType#

    StructureChangeType(..)                 ,


-- ** TagFlag #enum:TagFlag#

    TagFlag(..)                             ,


-- ** TagMergeMode #enum:TagMergeMode#

    TagMergeMode(..)                        ,


-- ** TagScope #enum:TagScope#

    TagScope(..)                            ,


-- ** TaskState #enum:TaskState#

    TaskState(..)                           ,


-- ** TocEntryType #enum:TocEntryType#

    TocEntryType(..)                        ,


-- ** TocLoopType #enum:TocLoopType#

    TocLoopType(..)                         ,


-- ** TocScope #enum:TocScope#

    TocScope(..)                            ,


-- ** TracerValueScope #enum:TracerValueScope#

    TracerValueScope(..)                    ,


-- ** TypeFindProbability #enum:TypeFindProbability#

    TypeFindProbability(..)                 ,


-- ** URIError #enum:URIError#

    URIError(..)                            ,
    catchURIError                           ,
    handleURIError                          ,


-- ** URIType #enum:URIType#

    URIType(..)                             ,




    ) 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 URIType
-- | The different types of URI direction.
data URIType = 
      URITypeUnknown
    -- ^ The URI direction is unknown
    | URITypeSink
    -- ^ The URI is a consumer.
    | URITypeSrc
    -- ^ The URI is a producer.
    | AnotherURIType Int
    -- ^ Catch-all for unknown values
    deriving (Int -> URIType -> ShowS
[URIType] -> ShowS
URIType -> String
(Int -> URIType -> ShowS)
-> (URIType -> String) -> ([URIType] -> ShowS) -> Show URIType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [URIType] -> ShowS
$cshowList :: [URIType] -> ShowS
show :: URIType -> String
$cshow :: URIType -> String
showsPrec :: Int -> URIType -> ShowS
$cshowsPrec :: Int -> URIType -> ShowS
Show, URIType -> URIType -> Bool
(URIType -> URIType -> Bool)
-> (URIType -> URIType -> Bool) -> Eq URIType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: URIType -> URIType -> Bool
$c/= :: URIType -> URIType -> Bool
== :: URIType -> URIType -> Bool
$c== :: URIType -> URIType -> Bool
Eq)

instance P.Enum URIType where
    fromEnum :: URIType -> Int
fromEnum URITypeUnknown = 0
    fromEnum URITypeSink = 1
    fromEnum URITypeSrc = 2
    fromEnum (AnotherURIType k :: Int
k) = Int
k

    toEnum :: Int -> URIType
toEnum 0 = URIType
URITypeUnknown
    toEnum 1 = URIType
URITypeSink
    toEnum 2 = URIType
URITypeSrc
    toEnum k :: Int
k = Int -> URIType
AnotherURIType Int
k

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

foreign import ccall "gst_uri_type_get_type" c_gst_uri_type_get_type :: 
    IO GType

instance BoxedEnum URIType where
    boxedEnumType :: URIType -> IO GType
boxedEnumType _ = IO GType
c_gst_uri_type_get_type

-- Enum URIError
-- | Different URI-related errors that can occur.
data URIError = 
      URIErrorUnsupportedProtocol
    -- ^ The protocol is not supported
    | URIErrorBadUri
    -- ^ There was a problem with the URI
    | URIErrorBadState
    -- ^ Could not set or change the URI because the
    --     URI handler was in a state where that is not possible or not permitted
    | URIErrorBadReference
    -- ^ There was a problem with the entity that
    --     the URI references
    | AnotherURIError Int
    -- ^ Catch-all for unknown values
    deriving (Int -> URIError -> ShowS
[URIError] -> ShowS
URIError -> String
(Int -> URIError -> ShowS)
-> (URIError -> String) -> ([URIError] -> ShowS) -> Show URIError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [URIError] -> ShowS
$cshowList :: [URIError] -> ShowS
show :: URIError -> String
$cshow :: URIError -> String
showsPrec :: Int -> URIError -> ShowS
$cshowsPrec :: Int -> URIError -> ShowS
Show, URIError -> URIError -> Bool
(URIError -> URIError -> Bool)
-> (URIError -> URIError -> Bool) -> Eq URIError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: URIError -> URIError -> Bool
$c/= :: URIError -> URIError -> Bool
== :: URIError -> URIError -> Bool
$c== :: URIError -> URIError -> Bool
Eq)

instance P.Enum URIError where
    fromEnum :: URIError -> Int
fromEnum URIErrorUnsupportedProtocol = 0
    fromEnum URIErrorBadUri = 1
    fromEnum URIErrorBadState = 2
    fromEnum URIErrorBadReference = 3
    fromEnum (AnotherURIError k :: Int
k) = Int
k

    toEnum :: Int -> URIError
toEnum 0 = URIError
URIErrorUnsupportedProtocol
    toEnum 1 = URIError
URIErrorBadUri
    toEnum 2 = URIError
URIErrorBadState
    toEnum 3 = URIError
URIErrorBadReference
    toEnum k :: Int
k = Int -> URIError
AnotherURIError Int
k

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

instance GErrorClass URIError where
    gerrorClassDomain :: URIError -> Text
gerrorClassDomain _ = "gst-uri-error-quark"

-- | Catch exceptions of type `URIError`. This is a specialized version of `Data.GI.Base.GError.catchGErrorJustDomain`.
catchURIError ::
    IO a ->
    (URIError -> GErrorMessage -> IO a) ->
    IO a
catchURIError :: IO a -> (URIError -> Text -> IO a) -> IO a
catchURIError = IO a -> (URIError -> Text -> IO a) -> IO a
forall err a.
GErrorClass err =>
IO a -> (err -> Text -> IO a) -> IO a
catchGErrorJustDomain

-- | Handle exceptions of type `URIError`. This is a specialized version of `Data.GI.Base.GError.handleGErrorJustDomain`.
handleURIError ::
    (URIError -> GErrorMessage -> IO a) ->
    IO a ->
    IO a
handleURIError :: (URIError -> Text -> IO a) -> IO a -> IO a
handleURIError = (URIError -> Text -> IO a) -> IO a -> IO a
forall err a.
GErrorClass err =>
(err -> Text -> IO a) -> IO a -> IO a
handleGErrorJustDomain

foreign import ccall "gst_uri_error_get_type" c_gst_uri_error_get_type :: 
    IO GType

instance BoxedEnum URIError where
    boxedEnumType :: URIError -> IO GType
boxedEnumType _ = IO GType
c_gst_uri_error_get_type

-- Enum TypeFindProbability
-- | The probability of the typefind function. Higher values have more certainty
-- in doing a reliable typefind.
data TypeFindProbability = 
      TypeFindProbabilityNone
    -- ^ type undetected.
    | TypeFindProbabilityMinimum
    -- ^ unlikely typefind.
    | TypeFindProbabilityPossible
    -- ^ possible type detected.
    | TypeFindProbabilityLikely
    -- ^ likely a type was detected.
    | TypeFindProbabilityNearlyCertain
    -- ^ nearly certain that a type was detected.
    | TypeFindProbabilityMaximum
    -- ^ very certain a type was detected.
    | AnotherTypeFindProbability Int
    -- ^ Catch-all for unknown values
    deriving (Int -> TypeFindProbability -> ShowS
[TypeFindProbability] -> ShowS
TypeFindProbability -> String
(Int -> TypeFindProbability -> ShowS)
-> (TypeFindProbability -> String)
-> ([TypeFindProbability] -> ShowS)
-> Show TypeFindProbability
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeFindProbability] -> ShowS
$cshowList :: [TypeFindProbability] -> ShowS
show :: TypeFindProbability -> String
$cshow :: TypeFindProbability -> String
showsPrec :: Int -> TypeFindProbability -> ShowS
$cshowsPrec :: Int -> TypeFindProbability -> ShowS
Show, TypeFindProbability -> TypeFindProbability -> Bool
(TypeFindProbability -> TypeFindProbability -> Bool)
-> (TypeFindProbability -> TypeFindProbability -> Bool)
-> Eq TypeFindProbability
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeFindProbability -> TypeFindProbability -> Bool
$c/= :: TypeFindProbability -> TypeFindProbability -> Bool
== :: TypeFindProbability -> TypeFindProbability -> Bool
$c== :: TypeFindProbability -> TypeFindProbability -> Bool
Eq)

instance P.Enum TypeFindProbability where
    fromEnum :: TypeFindProbability -> Int
fromEnum TypeFindProbabilityNone = 0
    fromEnum TypeFindProbabilityMinimum = 1
    fromEnum TypeFindProbabilityPossible = 50
    fromEnum TypeFindProbabilityLikely = 80
    fromEnum TypeFindProbabilityNearlyCertain = 99
    fromEnum TypeFindProbabilityMaximum = 100
    fromEnum (AnotherTypeFindProbability k :: Int
k) = Int
k

    toEnum :: Int -> TypeFindProbability
toEnum 0 = TypeFindProbability
TypeFindProbabilityNone
    toEnum 1 = TypeFindProbability
TypeFindProbabilityMinimum
    toEnum 50 = TypeFindProbability
TypeFindProbabilityPossible
    toEnum 80 = TypeFindProbability
TypeFindProbabilityLikely
    toEnum 99 = TypeFindProbability
TypeFindProbabilityNearlyCertain
    toEnum 100 = TypeFindProbability
TypeFindProbabilityMaximum
    toEnum k :: Int
k = Int -> TypeFindProbability
AnotherTypeFindProbability Int
k

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

foreign import ccall "gst_type_find_probability_get_type" c_gst_type_find_probability_get_type :: 
    IO GType

instance BoxedEnum TypeFindProbability where
    boxedEnumType :: TypeFindProbability -> IO GType
boxedEnumType _ = IO GType
c_gst_type_find_probability_get_type

-- Enum TracerValueScope
-- | Tracing record will contain fields that contain a measured value or extra
-- meta-data. One such meta data are values that tell where a measurement was
-- taken. This enumerating declares to which scope such a meta data field
-- relates to. If it is e.g. 'GI.Gst.Enums.TracerValueScopePad', then each of the log
-- events may contain values for different @/GstPads/@.
-- 
-- /Since: 1.8/
data TracerValueScope = 
      TracerValueScopeProcess
    -- ^ the value is related to the process
    | TracerValueScopeThread
    -- ^ the value is related to a thread
    | TracerValueScopeElement
    -- ^ the value is related to an t'GI.Gst.Objects.Element.Element'
    | TracerValueScopePad
    -- ^ the value is related to a t'GI.Gst.Objects.Pad.Pad'
    | AnotherTracerValueScope Int
    -- ^ Catch-all for unknown values
    deriving (Int -> TracerValueScope -> ShowS
[TracerValueScope] -> ShowS
TracerValueScope -> String
(Int -> TracerValueScope -> ShowS)
-> (TracerValueScope -> String)
-> ([TracerValueScope] -> ShowS)
-> Show TracerValueScope
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TracerValueScope] -> ShowS
$cshowList :: [TracerValueScope] -> ShowS
show :: TracerValueScope -> String
$cshow :: TracerValueScope -> String
showsPrec :: Int -> TracerValueScope -> ShowS
$cshowsPrec :: Int -> TracerValueScope -> ShowS
Show, TracerValueScope -> TracerValueScope -> Bool
(TracerValueScope -> TracerValueScope -> Bool)
-> (TracerValueScope -> TracerValueScope -> Bool)
-> Eq TracerValueScope
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TracerValueScope -> TracerValueScope -> Bool
$c/= :: TracerValueScope -> TracerValueScope -> Bool
== :: TracerValueScope -> TracerValueScope -> Bool
$c== :: TracerValueScope -> TracerValueScope -> Bool
Eq)

instance P.Enum TracerValueScope where
    fromEnum :: TracerValueScope -> Int
fromEnum TracerValueScopeProcess = 0
    fromEnum TracerValueScopeThread = 1
    fromEnum TracerValueScopeElement = 2
    fromEnum TracerValueScopePad = 3
    fromEnum (AnotherTracerValueScope k :: Int
k) = Int
k

    toEnum :: Int -> TracerValueScope
toEnum 0 = TracerValueScope
TracerValueScopeProcess
    toEnum 1 = TracerValueScope
TracerValueScopeThread
    toEnum 2 = TracerValueScope
TracerValueScopeElement
    toEnum 3 = TracerValueScope
TracerValueScopePad
    toEnum k :: Int
k = Int -> TracerValueScope
AnotherTracerValueScope Int
k

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

foreign import ccall "gst_tracer_value_scope_get_type" c_gst_tracer_value_scope_get_type :: 
    IO GType

instance BoxedEnum TracerValueScope where
    boxedEnumType :: TracerValueScope -> IO GType
boxedEnumType _ = IO GType
c_gst_tracer_value_scope_get_type

-- Enum TocScope
-- | The scope of a TOC.
data TocScope = 
      TocScopeGlobal
    -- ^ global TOC representing all selectable options
    --     (this is what applications are usually interested in)
    | TocScopeCurrent
    -- ^ TOC for the currently active\/selected stream
    --     (this is a TOC representing the current stream from start to EOS,
    --     and is what a TOC writer \/ muxer is usually interested in; it will
    --     usually be a subset of the global TOC, e.g. just the chapters of
    --     the current title, or the chapters selected for playback from the
    --     current title)
    | AnotherTocScope Int
    -- ^ Catch-all for unknown values
    deriving (Int -> TocScope -> ShowS
[TocScope] -> ShowS
TocScope -> String
(Int -> TocScope -> ShowS)
-> (TocScope -> String) -> ([TocScope] -> ShowS) -> Show TocScope
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TocScope] -> ShowS
$cshowList :: [TocScope] -> ShowS
show :: TocScope -> String
$cshow :: TocScope -> String
showsPrec :: Int -> TocScope -> ShowS
$cshowsPrec :: Int -> TocScope -> ShowS
Show, TocScope -> TocScope -> Bool
(TocScope -> TocScope -> Bool)
-> (TocScope -> TocScope -> Bool) -> Eq TocScope
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TocScope -> TocScope -> Bool
$c/= :: TocScope -> TocScope -> Bool
== :: TocScope -> TocScope -> Bool
$c== :: TocScope -> TocScope -> Bool
Eq)

instance P.Enum TocScope where
    fromEnum :: TocScope -> Int
fromEnum TocScopeGlobal = 1
    fromEnum TocScopeCurrent = 2
    fromEnum (AnotherTocScope k :: Int
k) = Int
k

    toEnum :: Int -> TocScope
toEnum 1 = TocScope
TocScopeGlobal
    toEnum 2 = TocScope
TocScopeCurrent
    toEnum k :: Int
k = Int -> TocScope
AnotherTocScope Int
k

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

foreign import ccall "gst_toc_scope_get_type" c_gst_toc_scope_get_type :: 
    IO GType

instance BoxedEnum TocScope where
    boxedEnumType :: TocScope -> IO GType
boxedEnumType _ = IO GType
c_gst_toc_scope_get_type

-- Enum TocLoopType
-- | How a t'GI.Gst.Structs.TocEntry.TocEntry' should be repeated. By default, entries are played a
-- single time.
-- 
-- /Since: 1.4/
data TocLoopType = 
      TocLoopTypeNone
    -- ^ single forward playback
    | TocLoopTypeForward
    -- ^ repeat forward
    | TocLoopTypeReverse
    -- ^ repeat backward
    | TocLoopTypePingPong
    -- ^ repeat forward and backward
    | AnotherTocLoopType Int
    -- ^ Catch-all for unknown values
    deriving (Int -> TocLoopType -> ShowS
[TocLoopType] -> ShowS
TocLoopType -> String
(Int -> TocLoopType -> ShowS)
-> (TocLoopType -> String)
-> ([TocLoopType] -> ShowS)
-> Show TocLoopType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TocLoopType] -> ShowS
$cshowList :: [TocLoopType] -> ShowS
show :: TocLoopType -> String
$cshow :: TocLoopType -> String
showsPrec :: Int -> TocLoopType -> ShowS
$cshowsPrec :: Int -> TocLoopType -> ShowS
Show, TocLoopType -> TocLoopType -> Bool
(TocLoopType -> TocLoopType -> Bool)
-> (TocLoopType -> TocLoopType -> Bool) -> Eq TocLoopType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TocLoopType -> TocLoopType -> Bool
$c/= :: TocLoopType -> TocLoopType -> Bool
== :: TocLoopType -> TocLoopType -> Bool
$c== :: TocLoopType -> TocLoopType -> Bool
Eq)

instance P.Enum TocLoopType where
    fromEnum :: TocLoopType -> Int
fromEnum TocLoopTypeNone = 0
    fromEnum TocLoopTypeForward = 1
    fromEnum TocLoopTypeReverse = 2
    fromEnum TocLoopTypePingPong = 3
    fromEnum (AnotherTocLoopType k :: Int
k) = Int
k

    toEnum :: Int -> TocLoopType
toEnum 0 = TocLoopType
TocLoopTypeNone
    toEnum 1 = TocLoopType
TocLoopTypeForward
    toEnum 2 = TocLoopType
TocLoopTypeReverse
    toEnum 3 = TocLoopType
TocLoopTypePingPong
    toEnum k :: Int
k = Int -> TocLoopType
AnotherTocLoopType Int
k

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

foreign import ccall "gst_toc_loop_type_get_type" c_gst_toc_loop_type_get_type :: 
    IO GType

instance BoxedEnum TocLoopType where
    boxedEnumType :: TocLoopType -> IO GType
boxedEnumType _ = IO GType
c_gst_toc_loop_type_get_type

-- Enum TocEntryType
-- | The different types of TOC entries (see t'GI.Gst.Structs.TocEntry.TocEntry').
-- 
-- There are two types of TOC entries: alternatives or parts in a sequence.
data TocEntryType = 
      TocEntryTypeAngle
    -- ^ entry is an angle (i.e. an alternative)
    | TocEntryTypeVersion
    -- ^ entry is a version (i.e. alternative)
    | TocEntryTypeEdition
    -- ^ entry is an edition (i.e. alternative)
    | TocEntryTypeInvalid
    -- ^ invalid entry type value
    | TocEntryTypeTitle
    -- ^ entry is a title (i.e. a part of a sequence)
    | TocEntryTypeTrack
    -- ^ entry is a track (i.e. a part of a sequence)
    | TocEntryTypeChapter
    -- ^ entry is a chapter (i.e. a part of a sequence)
    | AnotherTocEntryType Int
    -- ^ Catch-all for unknown values
    deriving (Int -> TocEntryType -> ShowS
[TocEntryType] -> ShowS
TocEntryType -> String
(Int -> TocEntryType -> ShowS)
-> (TocEntryType -> String)
-> ([TocEntryType] -> ShowS)
-> Show TocEntryType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TocEntryType] -> ShowS
$cshowList :: [TocEntryType] -> ShowS
show :: TocEntryType -> String
$cshow :: TocEntryType -> String
showsPrec :: Int -> TocEntryType -> ShowS
$cshowsPrec :: Int -> TocEntryType -> ShowS
Show, TocEntryType -> TocEntryType -> Bool
(TocEntryType -> TocEntryType -> Bool)
-> (TocEntryType -> TocEntryType -> Bool) -> Eq TocEntryType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TocEntryType -> TocEntryType -> Bool
$c/= :: TocEntryType -> TocEntryType -> Bool
== :: TocEntryType -> TocEntryType -> Bool
$c== :: TocEntryType -> TocEntryType -> Bool
Eq)

instance P.Enum TocEntryType where
    fromEnum :: TocEntryType -> Int
fromEnum TocEntryTypeAngle = -3
    fromEnum TocEntryTypeVersion = -2
    fromEnum TocEntryTypeEdition = -1
    fromEnum TocEntryTypeInvalid = 0
    fromEnum TocEntryTypeTitle = 1
    fromEnum TocEntryTypeTrack = 2
    fromEnum TocEntryTypeChapter = 3
    fromEnum (AnotherTocEntryType k :: Int
k) = Int
k

    toEnum :: Int -> TocEntryType
toEnum -3 = TocEntryType
TocEntryTypeAngle
    toEnum -2 = TocEntryType
TocEntryTypeVersion
    toEnum -1 = TocEntryType
TocEntryTypeEdition
    toEnum 0 = TocEntryType
TocEntryTypeInvalid
    toEnum 1 = TocEntryType
TocEntryTypeTitle
    toEnum 2 = TocEntryType
TocEntryTypeTrack
    toEnum 3 = TocEntryType
TocEntryTypeChapter
    toEnum k :: Int
k = Int -> TocEntryType
AnotherTocEntryType Int
k

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

foreign import ccall "gst_toc_entry_type_get_type" c_gst_toc_entry_type_get_type :: 
    IO GType

instance BoxedEnum TocEntryType where
    boxedEnumType :: TocEntryType -> IO GType
boxedEnumType _ = IO GType
c_gst_toc_entry_type_get_type

-- Enum TaskState
-- | The different states a task can be in
data TaskState = 
      TaskStateStarted
    -- ^ the task is started and running
    | TaskStateStopped
    -- ^ the task is stopped
    | TaskStatePaused
    -- ^ the task is paused
    | AnotherTaskState Int
    -- ^ Catch-all for unknown values
    deriving (Int -> TaskState -> ShowS
[TaskState] -> ShowS
TaskState -> String
(Int -> TaskState -> ShowS)
-> (TaskState -> String)
-> ([TaskState] -> ShowS)
-> Show TaskState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TaskState] -> ShowS
$cshowList :: [TaskState] -> ShowS
show :: TaskState -> String
$cshow :: TaskState -> String
showsPrec :: Int -> TaskState -> ShowS
$cshowsPrec :: Int -> TaskState -> ShowS
Show, TaskState -> TaskState -> Bool
(TaskState -> TaskState -> Bool)
-> (TaskState -> TaskState -> Bool) -> Eq TaskState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TaskState -> TaskState -> Bool
$c/= :: TaskState -> TaskState -> Bool
== :: TaskState -> TaskState -> Bool
$c== :: TaskState -> TaskState -> Bool
Eq)

instance P.Enum TaskState where
    fromEnum :: TaskState -> Int
fromEnum TaskStateStarted = 0
    fromEnum TaskStateStopped = 1
    fromEnum TaskStatePaused = 2
    fromEnum (AnotherTaskState k :: Int
k) = Int
k

    toEnum :: Int -> TaskState
toEnum 0 = TaskState
TaskStateStarted
    toEnum 1 = TaskState
TaskStateStopped
    toEnum 2 = TaskState
TaskStatePaused
    toEnum k :: Int
k = Int -> TaskState
AnotherTaskState Int
k

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

foreign import ccall "gst_task_state_get_type" c_gst_task_state_get_type :: 
    IO GType

instance BoxedEnum TaskState where
    boxedEnumType :: TaskState -> IO GType
boxedEnumType _ = IO GType
c_gst_task_state_get_type

-- Enum TagScope
-- | GstTagScope specifies if a taglist applies to the complete
-- medium or only to one single stream.
data TagScope = 
      TagScopeStream
    -- ^ tags specific to this single stream
    | TagScopeGlobal
    -- ^ global tags for the complete medium
    | AnotherTagScope Int
    -- ^ Catch-all for unknown values
    deriving (Int -> TagScope -> ShowS
[TagScope] -> ShowS
TagScope -> String
(Int -> TagScope -> ShowS)
-> (TagScope -> String) -> ([TagScope] -> ShowS) -> Show TagScope
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TagScope] -> ShowS
$cshowList :: [TagScope] -> ShowS
show :: TagScope -> String
$cshow :: TagScope -> String
showsPrec :: Int -> TagScope -> ShowS
$cshowsPrec :: Int -> TagScope -> ShowS
Show, TagScope -> TagScope -> Bool
(TagScope -> TagScope -> Bool)
-> (TagScope -> TagScope -> Bool) -> Eq TagScope
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TagScope -> TagScope -> Bool
$c/= :: TagScope -> TagScope -> Bool
== :: TagScope -> TagScope -> Bool
$c== :: TagScope -> TagScope -> Bool
Eq)

instance P.Enum TagScope where
    fromEnum :: TagScope -> Int
fromEnum TagScopeStream = 0
    fromEnum TagScopeGlobal = 1
    fromEnum (AnotherTagScope k :: Int
k) = Int
k

    toEnum :: Int -> TagScope
toEnum 0 = TagScope
TagScopeStream
    toEnum 1 = TagScope
TagScopeGlobal
    toEnum k :: Int
k = Int -> TagScope
AnotherTagScope Int
k

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

foreign import ccall "gst_tag_scope_get_type" c_gst_tag_scope_get_type :: 
    IO GType

instance BoxedEnum TagScope where
    boxedEnumType :: TagScope -> IO GType
boxedEnumType _ = IO GType
c_gst_tag_scope_get_type

-- Enum TagMergeMode
-- | The different tag merging modes are basically replace, overwrite and append,
-- but they can be seen from two directions. Given two taglists: (A) the tags
-- already in the element and (B) the ones that are supplied to the element (
-- e.g. via 'GI.Gst.Interfaces.TagSetter.tagSetterMergeTags' \/ @/gst_tag_setter_add_tags()/@ or a
-- 'GI.Gst.Enums.EventTypeTag'), how are these tags merged?
-- In the table below this is shown for the cases that a tag exists in the list
-- (A) or does not exists (!A) and combinations thereof.
-- 
-- \<table frame=\"all\" colsep=\"1\" rowsep=\"1\">
--   \<title>merge mode\<\/title>
--   \<tgroup cols=\'5\' align=\'left\'>
--     \<thead>
--       \<row>
--         \<entry>merge mode\<\/entry>
--         \<entry>A + B\<\/entry>
--         \<entry>A + !B\<\/entry>
--         \<entry>!A + B\<\/entry>
--         \<entry>!A + !B\<\/entry>
--       \<\/row>
--     \<\/thead>
--     \<tbody>
--       \<row>
--         \<entry>REPLACE_ALL\<\/entry>
--         \<entry>B\<\/entry>
--         \<entry>-\<\/entry>
--         \<entry>B\<\/entry>
--         \<entry>-\<\/entry>
--       \<\/row>
--       \<row>
--         \<entry>REPLACE\<\/entry>
--         \<entry>B\<\/entry>
--         \<entry>A\<\/entry>
--         \<entry>B\<\/entry>
--         \<entry>-\<\/entry>
--       \<\/row>
--       \<row>
--         \<entry>APPEND\<\/entry>
--         \<entry>A, B\<\/entry>
--         \<entry>A\<\/entry>
--         \<entry>B\<\/entry>
--         \<entry>-\<\/entry>
--       \<\/row>
--       \<row>
--         \<entry>PREPEND\<\/entry>
--         \<entry>B, A\<\/entry>
--         \<entry>A\<\/entry>
--         \<entry>B\<\/entry>
--         \<entry>-\<\/entry>
--       \<\/row>
--       \<row>
--         \<entry>KEEP\<\/entry>
--         \<entry>A\<\/entry>
--         \<entry>A\<\/entry>
--         \<entry>B\<\/entry>
--         \<entry>-\<\/entry>
--       \<\/row>
--       \<row>
--         \<entry>KEEP_ALL\<\/entry>
--         \<entry>A\<\/entry>
--         \<entry>A\<\/entry>
--         \<entry>-\<\/entry>
--         \<entry>-\<\/entry>
--       \<\/row>
--     \<\/tbody>
--   \<\/tgroup>
-- \<\/table>
data TagMergeMode = 
      TagMergeModeUndefined
    -- ^ undefined merge mode
    | TagMergeModeReplaceAll
    -- ^ replace all tags (clear list and append)
    | TagMergeModeReplace
    -- ^ replace tags
    | TagMergeModeAppend
    -- ^ append tags
    | TagMergeModePrepend
    -- ^ prepend tags
    | TagMergeModeKeep
    -- ^ keep existing tags
    | TagMergeModeKeepAll
    -- ^ keep all existing tags
    | TagMergeModeCount
    -- ^ the number of merge modes
    | AnotherTagMergeMode Int
    -- ^ Catch-all for unknown values
    deriving (Int -> TagMergeMode -> ShowS
[TagMergeMode] -> ShowS
TagMergeMode -> String
(Int -> TagMergeMode -> ShowS)
-> (TagMergeMode -> String)
-> ([TagMergeMode] -> ShowS)
-> Show TagMergeMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TagMergeMode] -> ShowS
$cshowList :: [TagMergeMode] -> ShowS
show :: TagMergeMode -> String
$cshow :: TagMergeMode -> String
showsPrec :: Int -> TagMergeMode -> ShowS
$cshowsPrec :: Int -> TagMergeMode -> ShowS
Show, TagMergeMode -> TagMergeMode -> Bool
(TagMergeMode -> TagMergeMode -> Bool)
-> (TagMergeMode -> TagMergeMode -> Bool) -> Eq TagMergeMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TagMergeMode -> TagMergeMode -> Bool
$c/= :: TagMergeMode -> TagMergeMode -> Bool
== :: TagMergeMode -> TagMergeMode -> Bool
$c== :: TagMergeMode -> TagMergeMode -> Bool
Eq)

instance P.Enum TagMergeMode where
    fromEnum :: TagMergeMode -> Int
fromEnum TagMergeModeUndefined = 0
    fromEnum TagMergeModeReplaceAll = 1
    fromEnum TagMergeModeReplace = 2
    fromEnum TagMergeModeAppend = 3
    fromEnum TagMergeModePrepend = 4
    fromEnum TagMergeModeKeep = 5
    fromEnum TagMergeModeKeepAll = 6
    fromEnum TagMergeModeCount = 7
    fromEnum (AnotherTagMergeMode k :: Int
k) = Int
k

    toEnum :: Int -> TagMergeMode
toEnum 0 = TagMergeMode
TagMergeModeUndefined
    toEnum 1 = TagMergeMode
TagMergeModeReplaceAll
    toEnum 2 = TagMergeMode
TagMergeModeReplace
    toEnum 3 = TagMergeMode
TagMergeModeAppend
    toEnum 4 = TagMergeMode
TagMergeModePrepend
    toEnum 5 = TagMergeMode
TagMergeModeKeep
    toEnum 6 = TagMergeMode
TagMergeModeKeepAll
    toEnum 7 = TagMergeMode
TagMergeModeCount
    toEnum k :: Int
k = Int -> TagMergeMode
AnotherTagMergeMode Int
k

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

foreign import ccall "gst_tag_merge_mode_get_type" c_gst_tag_merge_mode_get_type :: 
    IO GType

instance BoxedEnum TagMergeMode where
    boxedEnumType :: TagMergeMode -> IO GType
boxedEnumType _ = IO GType
c_gst_tag_merge_mode_get_type

-- Enum TagFlag
-- | Extra tag flags used when registering tags.
data TagFlag = 
      TagFlagUndefined
    -- ^ undefined flag
    | TagFlagMeta
    -- ^ tag is meta data
    | TagFlagEncoded
    -- ^ tag is encoded
    | TagFlagDecoded
    -- ^ tag is decoded
    | TagFlagCount
    -- ^ number of tag flags
    | AnotherTagFlag Int
    -- ^ Catch-all for unknown values
    deriving (Int -> TagFlag -> ShowS
[TagFlag] -> ShowS
TagFlag -> String
(Int -> TagFlag -> ShowS)
-> (TagFlag -> String) -> ([TagFlag] -> ShowS) -> Show TagFlag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TagFlag] -> ShowS
$cshowList :: [TagFlag] -> ShowS
show :: TagFlag -> String
$cshow :: TagFlag -> String
showsPrec :: Int -> TagFlag -> ShowS
$cshowsPrec :: Int -> TagFlag -> ShowS
Show, TagFlag -> TagFlag -> Bool
(TagFlag -> TagFlag -> Bool)
-> (TagFlag -> TagFlag -> Bool) -> Eq TagFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TagFlag -> TagFlag -> Bool
$c/= :: TagFlag -> TagFlag -> Bool
== :: TagFlag -> TagFlag -> Bool
$c== :: TagFlag -> TagFlag -> Bool
Eq)

instance P.Enum TagFlag where
    fromEnum :: TagFlag -> Int
fromEnum TagFlagUndefined = 0
    fromEnum TagFlagMeta = 1
    fromEnum TagFlagEncoded = 2
    fromEnum TagFlagDecoded = 3
    fromEnum TagFlagCount = 4
    fromEnum (AnotherTagFlag k :: Int
k) = Int
k

    toEnum :: Int -> TagFlag
toEnum 0 = TagFlag
TagFlagUndefined
    toEnum 1 = TagFlag
TagFlagMeta
    toEnum 2 = TagFlag
TagFlagEncoded
    toEnum 3 = TagFlag
TagFlagDecoded
    toEnum 4 = TagFlag
TagFlagCount
    toEnum k :: Int
k = Int -> TagFlag
AnotherTagFlag Int
k

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

foreign import ccall "gst_tag_flag_get_type" c_gst_tag_flag_get_type :: 
    IO GType

instance BoxedEnum TagFlag where
    boxedEnumType :: TagFlag -> IO GType
boxedEnumType _ = IO GType
c_gst_tag_flag_get_type

-- Enum StructureChangeType
-- | The type of a 'GI.Gst.Flags.MessageTypeStructureChange'.
data StructureChangeType = 
      StructureChangeTypeLink
    -- ^ Pad linking is starting or done.
    | StructureChangeTypeUnlink
    -- ^ Pad unlinking is starting or done.
    | AnotherStructureChangeType Int
    -- ^ Catch-all for unknown values
    deriving (Int -> StructureChangeType -> ShowS
[StructureChangeType] -> ShowS
StructureChangeType -> String
(Int -> StructureChangeType -> ShowS)
-> (StructureChangeType -> String)
-> ([StructureChangeType] -> ShowS)
-> Show StructureChangeType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StructureChangeType] -> ShowS
$cshowList :: [StructureChangeType] -> ShowS
show :: StructureChangeType -> String
$cshow :: StructureChangeType -> String
showsPrec :: Int -> StructureChangeType -> ShowS
$cshowsPrec :: Int -> StructureChangeType -> ShowS
Show, StructureChangeType -> StructureChangeType -> Bool
(StructureChangeType -> StructureChangeType -> Bool)
-> (StructureChangeType -> StructureChangeType -> Bool)
-> Eq StructureChangeType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StructureChangeType -> StructureChangeType -> Bool
$c/= :: StructureChangeType -> StructureChangeType -> Bool
== :: StructureChangeType -> StructureChangeType -> Bool
$c== :: StructureChangeType -> StructureChangeType -> Bool
Eq)

instance P.Enum StructureChangeType where
    fromEnum :: StructureChangeType -> Int
fromEnum StructureChangeTypeLink = 0
    fromEnum StructureChangeTypeUnlink = 1
    fromEnum (AnotherStructureChangeType k :: Int
k) = Int
k

    toEnum :: Int -> StructureChangeType
toEnum 0 = StructureChangeType
StructureChangeTypeLink
    toEnum 1 = StructureChangeType
StructureChangeTypeUnlink
    toEnum k :: Int
k = Int -> StructureChangeType
AnotherStructureChangeType Int
k

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

foreign import ccall "gst_structure_change_type_get_type" c_gst_structure_change_type_get_type :: 
    IO GType

instance BoxedEnum StructureChangeType where
    boxedEnumType :: StructureChangeType -> IO GType
boxedEnumType _ = IO GType
c_gst_structure_change_type_get_type

-- Enum StreamStatusType
-- | The type of a 'GI.Gst.Flags.MessageTypeStreamStatus'. The stream status messages inform the
-- application of new streaming threads and their status.
data StreamStatusType = 
      StreamStatusTypeCreate
    -- ^ A new thread need to be created.
    | StreamStatusTypeEnter
    -- ^ a thread entered its loop function
    | StreamStatusTypeLeave
    -- ^ a thread left its loop function
    | StreamStatusTypeDestroy
    -- ^ a thread is destroyed
    | StreamStatusTypeStart
    -- ^ a thread is started
    | StreamStatusTypePause
    -- ^ a thread is paused
    | StreamStatusTypeStop
    -- ^ a thread is stopped
    | AnotherStreamStatusType Int
    -- ^ Catch-all for unknown values
    deriving (Int -> StreamStatusType -> ShowS
[StreamStatusType] -> ShowS
StreamStatusType -> String
(Int -> StreamStatusType -> ShowS)
-> (StreamStatusType -> String)
-> ([StreamStatusType] -> ShowS)
-> Show StreamStatusType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StreamStatusType] -> ShowS
$cshowList :: [StreamStatusType] -> ShowS
show :: StreamStatusType -> String
$cshow :: StreamStatusType -> String
showsPrec :: Int -> StreamStatusType -> ShowS
$cshowsPrec :: Int -> StreamStatusType -> ShowS
Show, StreamStatusType -> StreamStatusType -> Bool
(StreamStatusType -> StreamStatusType -> Bool)
-> (StreamStatusType -> StreamStatusType -> Bool)
-> Eq StreamStatusType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StreamStatusType -> StreamStatusType -> Bool
$c/= :: StreamStatusType -> StreamStatusType -> Bool
== :: StreamStatusType -> StreamStatusType -> Bool
$c== :: StreamStatusType -> StreamStatusType -> Bool
Eq)

instance P.Enum StreamStatusType where
    fromEnum :: StreamStatusType -> Int
fromEnum StreamStatusTypeCreate = 0
    fromEnum StreamStatusTypeEnter = 1
    fromEnum StreamStatusTypeLeave = 2
    fromEnum StreamStatusTypeDestroy = 3
    fromEnum StreamStatusTypeStart = 8
    fromEnum StreamStatusTypePause = 9
    fromEnum StreamStatusTypeStop = 10
    fromEnum (AnotherStreamStatusType k :: Int
k) = Int
k

    toEnum :: Int -> StreamStatusType
toEnum 0 = StreamStatusType
StreamStatusTypeCreate
    toEnum 1 = StreamStatusType
StreamStatusTypeEnter
    toEnum 2 = StreamStatusType
StreamStatusTypeLeave
    toEnum 3 = StreamStatusType
StreamStatusTypeDestroy
    toEnum 8 = StreamStatusType
StreamStatusTypeStart
    toEnum 9 = StreamStatusType
StreamStatusTypePause
    toEnum 10 = StreamStatusType
StreamStatusTypeStop
    toEnum k :: Int
k = Int -> StreamStatusType
AnotherStreamStatusType Int
k

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

foreign import ccall "gst_stream_status_type_get_type" c_gst_stream_status_type_get_type :: 
    IO GType

instance BoxedEnum StreamStatusType where
    boxedEnumType :: StreamStatusType -> IO GType
boxedEnumType _ = IO GType
c_gst_stream_status_type_get_type

-- Enum StreamError
-- | Stream errors are for anything related to the stream being processed:
-- format errors, media type errors, ...
-- They\'re typically used by decoders, demuxers, converters, ...
data StreamError = 
      StreamErrorFailed
    -- ^ a general error which doesn\'t fit in any other
    -- category.  Make sure you add a custom message to the error call.
    | StreamErrorTooLazy
    -- ^ do not use this except as a placeholder for
    -- deciding where to go while developing code.
    | StreamErrorNotImplemented
    -- ^ use this when you do not want to implement
    -- this functionality yet.
    | StreamErrorTypeNotFound
    -- ^ used when the element doesn\'t know the
    -- stream\'s type.
    | StreamErrorWrongType
    -- ^ used when the element doesn\'t handle this type
    -- of stream.
    | StreamErrorCodecNotFound
    -- ^ used when there\'s no codec to handle the
    -- stream\'s type.
    | StreamErrorDecode
    -- ^ used when decoding fails.
    | StreamErrorEncode
    -- ^ used when encoding fails.
    | StreamErrorDemux
    -- ^ used when demuxing fails.
    | StreamErrorMux
    -- ^ used when muxing fails.
    | StreamErrorFormat
    -- ^ used when the stream is of the wrong format
    -- (for example, wrong caps).
    | StreamErrorDecrypt
    -- ^ used when the stream is encrypted and can\'t be
    -- decrypted because this is not supported by the element.
    | StreamErrorDecryptNokey
    -- ^ used when the stream is encrypted and
    -- can\'t be decrypted because no suitable key is available.
    | StreamErrorNumErrors
    -- ^ the number of stream error types.
    | AnotherStreamError Int
    -- ^ Catch-all for unknown values
    deriving (Int -> StreamError -> ShowS
[StreamError] -> ShowS
StreamError -> String
(Int -> StreamError -> ShowS)
-> (StreamError -> String)
-> ([StreamError] -> ShowS)
-> Show StreamError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StreamError] -> ShowS
$cshowList :: [StreamError] -> ShowS
show :: StreamError -> String
$cshow :: StreamError -> String
showsPrec :: Int -> StreamError -> ShowS
$cshowsPrec :: Int -> StreamError -> ShowS
Show, StreamError -> StreamError -> Bool
(StreamError -> StreamError -> Bool)
-> (StreamError -> StreamError -> Bool) -> Eq StreamError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StreamError -> StreamError -> Bool
$c/= :: StreamError -> StreamError -> Bool
== :: StreamError -> StreamError -> Bool
$c== :: StreamError -> StreamError -> Bool
Eq)

instance P.Enum StreamError where
    fromEnum :: StreamError -> Int
fromEnum StreamErrorFailed = 1
    fromEnum StreamErrorTooLazy = 2
    fromEnum StreamErrorNotImplemented = 3
    fromEnum StreamErrorTypeNotFound = 4
    fromEnum StreamErrorWrongType = 5
    fromEnum StreamErrorCodecNotFound = 6
    fromEnum StreamErrorDecode = 7
    fromEnum StreamErrorEncode = 8
    fromEnum StreamErrorDemux = 9
    fromEnum StreamErrorMux = 10
    fromEnum StreamErrorFormat = 11
    fromEnum StreamErrorDecrypt = 12
    fromEnum StreamErrorDecryptNokey = 13
    fromEnum StreamErrorNumErrors = 14
    fromEnum (AnotherStreamError k :: Int
k) = Int
k

    toEnum :: Int -> StreamError
toEnum 1 = StreamError
StreamErrorFailed
    toEnum 2 = StreamError
StreamErrorTooLazy
    toEnum 3 = StreamError
StreamErrorNotImplemented
    toEnum 4 = StreamError
StreamErrorTypeNotFound
    toEnum 5 = StreamError
StreamErrorWrongType
    toEnum 6 = StreamError
StreamErrorCodecNotFound
    toEnum 7 = StreamError
StreamErrorDecode
    toEnum 8 = StreamError
StreamErrorEncode
    toEnum 9 = StreamError
StreamErrorDemux
    toEnum 10 = StreamError
StreamErrorMux
    toEnum 11 = StreamError
StreamErrorFormat
    toEnum 12 = StreamError
StreamErrorDecrypt
    toEnum 13 = StreamError
StreamErrorDecryptNokey
    toEnum 14 = StreamError
StreamErrorNumErrors
    toEnum k :: Int
k = Int -> StreamError
AnotherStreamError Int
k

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

instance GErrorClass StreamError where
    gerrorClassDomain :: StreamError -> Text
gerrorClassDomain _ = "gst-stream-error-quark"

-- | Catch exceptions of type `StreamError`. This is a specialized version of `Data.GI.Base.GError.catchGErrorJustDomain`.
catchStreamError ::
    IO a ->
    (StreamError -> GErrorMessage -> IO a) ->
    IO a
catchStreamError :: IO a -> (StreamError -> Text -> IO a) -> IO a
catchStreamError = IO a -> (StreamError -> Text -> IO a) -> IO a
forall err a.
GErrorClass err =>
IO a -> (err -> Text -> IO a) -> IO a
catchGErrorJustDomain

-- | Handle exceptions of type `StreamError`. This is a specialized version of `Data.GI.Base.GError.handleGErrorJustDomain`.
handleStreamError ::
    (StreamError -> GErrorMessage -> IO a) ->
    IO a ->
    IO a
handleStreamError :: (StreamError -> Text -> IO a) -> IO a -> IO a
handleStreamError = (StreamError -> Text -> IO a) -> IO a -> IO a
forall err a.
GErrorClass err =>
(err -> Text -> IO a) -> IO a -> IO a
handleGErrorJustDomain

foreign import ccall "gst_stream_error_get_type" c_gst_stream_error_get_type :: 
    IO GType

instance BoxedEnum StreamError where
    boxedEnumType :: StreamError -> IO GType
boxedEnumType _ = IO GType
c_gst_stream_error_get_type

-- Enum StateChangeReturn
-- | The possible return values from a state change function such as
-- 'GI.Gst.Objects.Element.elementSetState'. Only /@gSTSTATECHANGEFAILURE@/ is a real failure.
data StateChangeReturn = 
      StateChangeReturnFailure
    -- ^ the state change failed
    | StateChangeReturnSuccess
    -- ^ the state change succeeded
    | StateChangeReturnAsync
    -- ^ the state change will happen asynchronously
    | StateChangeReturnNoPreroll
    -- ^ the state change succeeded but the element
    --                               cannot produce data in 'GI.Gst.Enums.StatePaused'.
    --                               This typically happens with live sources.
    | AnotherStateChangeReturn Int
    -- ^ Catch-all for unknown values
    deriving (Int -> StateChangeReturn -> ShowS
[StateChangeReturn] -> ShowS
StateChangeReturn -> String
(Int -> StateChangeReturn -> ShowS)
-> (StateChangeReturn -> String)
-> ([StateChangeReturn] -> ShowS)
-> Show StateChangeReturn
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StateChangeReturn] -> ShowS
$cshowList :: [StateChangeReturn] -> ShowS
show :: StateChangeReturn -> String
$cshow :: StateChangeReturn -> String
showsPrec :: Int -> StateChangeReturn -> ShowS
$cshowsPrec :: Int -> StateChangeReturn -> ShowS
Show, StateChangeReturn -> StateChangeReturn -> Bool
(StateChangeReturn -> StateChangeReturn -> Bool)
-> (StateChangeReturn -> StateChangeReturn -> Bool)
-> Eq StateChangeReturn
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StateChangeReturn -> StateChangeReturn -> Bool
$c/= :: StateChangeReturn -> StateChangeReturn -> Bool
== :: StateChangeReturn -> StateChangeReturn -> Bool
$c== :: StateChangeReturn -> StateChangeReturn -> Bool
Eq)

instance P.Enum StateChangeReturn where
    fromEnum :: StateChangeReturn -> Int
fromEnum StateChangeReturnFailure = 0
    fromEnum StateChangeReturnSuccess = 1
    fromEnum StateChangeReturnAsync = 2
    fromEnum StateChangeReturnNoPreroll = 3
    fromEnum (AnotherStateChangeReturn k :: Int
k) = Int
k

    toEnum :: Int -> StateChangeReturn
toEnum 0 = StateChangeReturn
StateChangeReturnFailure
    toEnum 1 = StateChangeReturn
StateChangeReturnSuccess
    toEnum 2 = StateChangeReturn
StateChangeReturnAsync
    toEnum 3 = StateChangeReturn
StateChangeReturnNoPreroll
    toEnum k :: Int
k = Int -> StateChangeReturn
AnotherStateChangeReturn Int
k

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

foreign import ccall "gst_state_change_return_get_type" c_gst_state_change_return_get_type :: 
    IO GType

instance BoxedEnum StateChangeReturn where
    boxedEnumType :: StateChangeReturn -> IO GType
boxedEnumType _ = IO GType
c_gst_state_change_return_get_type

-- Enum StateChange
-- | These are the different state changes an element goes through.
-- 'GI.Gst.Enums.StateNull' &rArr; 'GI.Gst.Enums.StatePlaying' is called an upwards state change
-- and 'GI.Gst.Enums.StatePlaying' &rArr; 'GI.Gst.Enums.StateNull' a downwards state change.
data StateChange = 
      StateChangeNullToReady
    -- ^ state change from NULL to READY.
    --   * The element must check if the resources it needs are available. Device
    --     sinks and -sources typically try to probe the device to constrain their
    --     caps.
    --   * The element opens the device (in case feature need to be probed).
    | StateChangeReadyToPaused
    -- ^ state change from READY to PAUSED.
    --   * The element pads are activated in order to receive data in PAUSED.
    --     Streaming threads are started.
    --   * Some elements might need to return 'GI.Gst.Enums.StateChangeReturnAsync' and complete
    --     the state change when they have enough information. It is a requirement
    --     for sinks to return 'GI.Gst.Enums.StateChangeReturnAsync' and complete the state change
    --     when they receive the first buffer or 'GI.Gst.Enums.EventTypeEos' (preroll).
    --     Sinks also block the dataflow when in PAUSED.
    --   * A pipeline resets the running_time to 0.
    --   * Live sources return 'GI.Gst.Enums.StateChangeReturnNoPreroll' and don\'t generate data.
    | StateChangePausedToPlaying
    -- ^ state change from PAUSED to PLAYING.
    --   * Most elements ignore this state change.
    --   * The pipeline selects a t'GI.Gst.Objects.Clock.Clock' and distributes this to all the children
    --     before setting them to PLAYING. This means that it is only allowed to
    --     synchronize on the t'GI.Gst.Objects.Clock.Clock' in the PLAYING state.
    --   * The pipeline uses the t'GI.Gst.Objects.Clock.Clock' and the running_time to calculate the
    --     base_time. The base_time is distributed to all children when performing
    --     the state change.
    --   * Sink elements stop blocking on the preroll buffer or event and start
    --     rendering the data.
    --   * Sinks can post 'GI.Gst.Flags.MessageTypeEos' in the PLAYING state. It is not allowed
    --     to post 'GI.Gst.Flags.MessageTypeEos' when not in the PLAYING state.
    --   * While streaming in PAUSED or PLAYING elements can create and remove
    --     sometimes pads.
    --   * Live sources start generating data and return 'GI.Gst.Enums.StateChangeReturnSuccess'.
    | StateChangePlayingToPaused
    -- ^ state change from PLAYING to PAUSED.
    --   * Most elements ignore this state change.
    --   * The pipeline calculates the running_time based on the last selected
    --     t'GI.Gst.Objects.Clock.Clock' and the base_time. It stores this information to continue
    --     playback when going back to the PLAYING state.
    --   * Sinks unblock any t'GI.Gst.Objects.Clock.Clock' wait calls.
    --   * When a sink does not have a pending buffer to play, it returns
    --     @/GST_STATE_CHANGE_ASYNC/@ from this state change and completes the state
    --     change when it receives a new buffer or an 'GI.Gst.Enums.EventTypeEos'.
    --   * Any queued 'GI.Gst.Flags.MessageTypeEos' items are removed since they will be reposted
    --     when going back to the PLAYING state. The EOS messages are queued in
    --     t'GI.Gst.Objects.Bin.Bin' containers.
    --   * Live sources stop generating data and return 'GI.Gst.Enums.StateChangeReturnNoPreroll'.
    | StateChangePausedToReady
    -- ^ state change from PAUSED to READY.
    --   * Sinks unblock any waits in the preroll.
    --   * Elements unblock any waits on devices
    --   * Chain or get_range functions return 'GI.Gst.Enums.FlowReturnFlushing'.
    --   * The element pads are deactivated so that streaming becomes impossible and
    --     all streaming threads are stopped.
    --   * The sink forgets all negotiated formats
    --   * Elements remove all sometimes pads
    | StateChangeReadyToNull
    -- ^ state change from READY to NULL.
    --   * Elements close devices
    --   * Elements reset any internal state.
    | StateChangeNullToNull
    -- ^ state change from NULL to NULL. (Since 1.14)
    | StateChangeReadyToReady
    -- ^ state change from READY to READY,
    -- This might happen when going to PAUSED asynchronously failed, in that case
    -- elements should make sure they are in a proper, coherent READY state. (Since 1.14)
    | StateChangePausedToPaused
    -- ^ state change from PAUSED to PAUSED.
    -- This might happen when elements were in PLAYING state and \'lost state\',
    -- they should make sure to go back to real \'PAUSED\' state (prerolling for example). (Since 1.14)
    | StateChangePlayingToPlaying
    -- ^ state change from PLAYING to PLAYING. (Since 1.14)
    | AnotherStateChange Int
    -- ^ Catch-all for unknown values
    deriving (Int -> StateChange -> ShowS
[StateChange] -> ShowS
StateChange -> String
(Int -> StateChange -> ShowS)
-> (StateChange -> String)
-> ([StateChange] -> ShowS)
-> Show StateChange
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StateChange] -> ShowS
$cshowList :: [StateChange] -> ShowS
show :: StateChange -> String
$cshow :: StateChange -> String
showsPrec :: Int -> StateChange -> ShowS
$cshowsPrec :: Int -> StateChange -> ShowS
Show, StateChange -> StateChange -> Bool
(StateChange -> StateChange -> Bool)
-> (StateChange -> StateChange -> Bool) -> Eq StateChange
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StateChange -> StateChange -> Bool
$c/= :: StateChange -> StateChange -> Bool
== :: StateChange -> StateChange -> Bool
$c== :: StateChange -> StateChange -> Bool
Eq)

instance P.Enum StateChange where
    fromEnum :: StateChange -> Int
fromEnum StateChangeNullToReady = 10
    fromEnum StateChangeReadyToPaused = 19
    fromEnum StateChangePausedToPlaying = 28
    fromEnum StateChangePlayingToPaused = 35
    fromEnum StateChangePausedToReady = 26
    fromEnum StateChangeReadyToNull = 17
    fromEnum StateChangeNullToNull = 9
    fromEnum StateChangeReadyToReady = 18
    fromEnum StateChangePausedToPaused = 27
    fromEnum StateChangePlayingToPlaying = 36
    fromEnum (AnotherStateChange k :: Int
k) = Int
k

    toEnum :: Int -> StateChange
toEnum 10 = StateChange
StateChangeNullToReady
    toEnum 19 = StateChange
StateChangeReadyToPaused
    toEnum 28 = StateChange
StateChangePausedToPlaying
    toEnum 35 = StateChange
StateChangePlayingToPaused
    toEnum 26 = StateChange
StateChangePausedToReady
    toEnum 17 = StateChange
StateChangeReadyToNull
    toEnum 9 = StateChange
StateChangeNullToNull
    toEnum 18 = StateChange
StateChangeReadyToReady
    toEnum 27 = StateChange
StateChangePausedToPaused
    toEnum 36 = StateChange
StateChangePlayingToPlaying
    toEnum k :: Int
k = Int -> StateChange
AnotherStateChange Int
k

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

foreign import ccall "gst_state_change_get_type" c_gst_state_change_get_type :: 
    IO GType

instance BoxedEnum StateChange where
    boxedEnumType :: StateChange -> IO GType
boxedEnumType _ = IO GType
c_gst_state_change_get_type

-- Enum State
-- | The possible states an element can be in. States can be changed using
-- 'GI.Gst.Objects.Element.elementSetState' and checked using 'GI.Gst.Objects.Element.elementGetState'.
data State = 
      StateVoidPending
    -- ^ no pending state.
    | StateNull
    -- ^ the NULL state or initial state of an element.
    | StateReady
    -- ^ the element is ready to go to PAUSED.
    | StatePaused
    -- ^ the element is PAUSED, it is ready to accept and
    --                          process data. Sink elements however only accept one
    --                          buffer and then block.
    | StatePlaying
    -- ^ the element is PLAYING, the t'GI.Gst.Objects.Clock.Clock' is running and
    --                          the data is flowing.
    | AnotherState Int
    -- ^ Catch-all for unknown values
    deriving (Int -> State -> ShowS
[State] -> ShowS
State -> String
(Int -> State -> ShowS)
-> (State -> String) -> ([State] -> ShowS) -> Show State
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [State] -> ShowS
$cshowList :: [State] -> ShowS
show :: State -> String
$cshow :: State -> String
showsPrec :: Int -> State -> ShowS
$cshowsPrec :: Int -> State -> ShowS
Show, 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)

instance P.Enum State where
    fromEnum :: State -> Int
fromEnum StateVoidPending = 0
    fromEnum StateNull = 1
    fromEnum StateReady = 2
    fromEnum StatePaused = 3
    fromEnum StatePlaying = 4
    fromEnum (AnotherState k :: Int
k) = Int
k

    toEnum :: Int -> State
toEnum 0 = State
StateVoidPending
    toEnum 1 = State
StateNull
    toEnum 2 = State
StateReady
    toEnum 3 = State
StatePaused
    toEnum 4 = State
StatePlaying
    toEnum k :: Int
k = Int -> State
AnotherState Int
k

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

foreign import ccall "gst_state_get_type" c_gst_state_get_type :: 
    IO GType

instance BoxedEnum State where
    boxedEnumType :: State -> IO GType
boxedEnumType _ = IO GType
c_gst_state_get_type

-- Enum SeekType
-- | The different types of seek events. When constructing a seek event with
-- 'GI.Gst.Structs.Event.eventNewSeek' or when doing gst_segment_do_seek ().
data SeekType = 
      SeekTypeNone
    -- ^ no change in position is required
    | SeekTypeSet
    -- ^ absolute position is requested
    | SeekTypeEnd
    -- ^ relative position to duration is requested
    | AnotherSeekType Int
    -- ^ Catch-all for unknown values
    deriving (Int -> SeekType -> ShowS
[SeekType] -> ShowS
SeekType -> String
(Int -> SeekType -> ShowS)
-> (SeekType -> String) -> ([SeekType] -> ShowS) -> Show SeekType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SeekType] -> ShowS
$cshowList :: [SeekType] -> ShowS
show :: SeekType -> String
$cshow :: SeekType -> String
showsPrec :: Int -> SeekType -> ShowS
$cshowsPrec :: Int -> SeekType -> ShowS
Show, SeekType -> SeekType -> Bool
(SeekType -> SeekType -> Bool)
-> (SeekType -> SeekType -> Bool) -> Eq SeekType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SeekType -> SeekType -> Bool
$c/= :: SeekType -> SeekType -> Bool
== :: SeekType -> SeekType -> Bool
$c== :: SeekType -> SeekType -> Bool
Eq)

instance P.Enum SeekType where
    fromEnum :: SeekType -> Int
fromEnum SeekTypeNone = 0
    fromEnum SeekTypeSet = 1
    fromEnum SeekTypeEnd = 2
    fromEnum (AnotherSeekType k :: Int
k) = Int
k

    toEnum :: Int -> SeekType
toEnum 0 = SeekType
SeekTypeNone
    toEnum 1 = SeekType
SeekTypeSet
    toEnum 2 = SeekType
SeekTypeEnd
    toEnum k :: Int
k = Int -> SeekType
AnotherSeekType Int
k

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

foreign import ccall "gst_seek_type_get_type" c_gst_seek_type_get_type :: 
    IO GType

instance BoxedEnum SeekType where
    boxedEnumType :: SeekType -> IO GType
boxedEnumType _ = IO GType
c_gst_seek_type_get_type

-- Enum SearchMode
-- | The different search modes.
data SearchMode = 
      SearchModeExact
    -- ^ Only search for exact matches.
    | SearchModeBefore
    -- ^ Search for an exact match or the element just before.
    | SearchModeAfter
    -- ^ Search for an exact match or the element just after.
    | AnotherSearchMode Int
    -- ^ Catch-all for unknown values
    deriving (Int -> SearchMode -> ShowS
[SearchMode] -> ShowS
SearchMode -> String
(Int -> SearchMode -> ShowS)
-> (SearchMode -> String)
-> ([SearchMode] -> ShowS)
-> Show SearchMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SearchMode] -> ShowS
$cshowList :: [SearchMode] -> ShowS
show :: SearchMode -> String
$cshow :: SearchMode -> String
showsPrec :: Int -> SearchMode -> ShowS
$cshowsPrec :: Int -> SearchMode -> ShowS
Show, SearchMode -> SearchMode -> Bool
(SearchMode -> SearchMode -> Bool)
-> (SearchMode -> SearchMode -> Bool) -> Eq SearchMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SearchMode -> SearchMode -> Bool
$c/= :: SearchMode -> SearchMode -> Bool
== :: SearchMode -> SearchMode -> Bool
$c== :: SearchMode -> SearchMode -> Bool
Eq)

instance P.Enum SearchMode where
    fromEnum :: SearchMode -> Int
fromEnum SearchModeExact = 0
    fromEnum SearchModeBefore = 1
    fromEnum SearchModeAfter = 2
    fromEnum (AnotherSearchMode k :: Int
k) = Int
k

    toEnum :: Int -> SearchMode
toEnum 0 = SearchMode
SearchModeExact
    toEnum 1 = SearchMode
SearchModeBefore
    toEnum 2 = SearchMode
SearchModeAfter
    toEnum k :: Int
k = Int -> SearchMode
AnotherSearchMode Int
k

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

foreign import ccall "gst_search_mode_get_type" c_gst_search_mode_get_type :: 
    IO GType

instance BoxedEnum SearchMode where
    boxedEnumType :: SearchMode -> IO GType
boxedEnumType _ = IO GType
c_gst_search_mode_get_type

-- Enum ResourceError
-- | Resource errors are for any resource used by an element:
-- memory, files, network connections, process space, ...
-- They\'re typically used by source and sink elements.
data ResourceError = 
      ResourceErrorFailed
    -- ^ a general error which doesn\'t fit in any other
    -- category.  Make sure you add a custom message to the error call.
    | ResourceErrorTooLazy
    -- ^ do not use this except as a placeholder for
    -- deciding where to go while developing code.
    | ResourceErrorNotFound
    -- ^ used when the resource could not be found.
    | ResourceErrorBusy
    -- ^ used when resource is busy.
    | ResourceErrorOpenRead
    -- ^ used when resource fails to open for reading.
    | ResourceErrorOpenWrite
    -- ^ used when resource fails to open for writing.
    | ResourceErrorOpenReadWrite
    -- ^ used when resource cannot be opened for
    -- both reading and writing, or either (but unspecified which).
    | ResourceErrorClose
    -- ^ used when the resource can\'t be closed.
    | ResourceErrorRead
    -- ^ used when the resource can\'t be read from.
    | ResourceErrorWrite
    -- ^ used when the resource can\'t be written to.
    | ResourceErrorSeek
    -- ^ used when a seek on the resource fails.
    | ResourceErrorSync
    -- ^ used when a synchronize on the resource fails.
    | ResourceErrorSettings
    -- ^ used when settings can\'t be manipulated on.
    | ResourceErrorNoSpaceLeft
    -- ^ used when the resource has no space left.
    | ResourceErrorNotAuthorized
    -- ^ used when the resource can\'t be opened
    --                                     due to missing authorization.
    --                                     (Since 1.2.4)
    | ResourceErrorNumErrors
    -- ^ the number of resource error types.
    | AnotherResourceError Int
    -- ^ Catch-all for unknown values
    deriving (Int -> ResourceError -> ShowS
[ResourceError] -> ShowS
ResourceError -> String
(Int -> ResourceError -> ShowS)
-> (ResourceError -> String)
-> ([ResourceError] -> ShowS)
-> Show ResourceError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResourceError] -> ShowS
$cshowList :: [ResourceError] -> ShowS
show :: ResourceError -> String
$cshow :: ResourceError -> String
showsPrec :: Int -> ResourceError -> ShowS
$cshowsPrec :: Int -> ResourceError -> ShowS
Show, ResourceError -> ResourceError -> Bool
(ResourceError -> ResourceError -> Bool)
-> (ResourceError -> ResourceError -> Bool) -> Eq ResourceError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResourceError -> ResourceError -> Bool
$c/= :: ResourceError -> ResourceError -> Bool
== :: ResourceError -> ResourceError -> Bool
$c== :: ResourceError -> ResourceError -> Bool
Eq)

instance P.Enum ResourceError where
    fromEnum :: ResourceError -> Int
fromEnum ResourceErrorFailed = 1
    fromEnum ResourceErrorTooLazy = 2
    fromEnum ResourceErrorNotFound = 3
    fromEnum ResourceErrorBusy = 4
    fromEnum ResourceErrorOpenRead = 5
    fromEnum ResourceErrorOpenWrite = 6
    fromEnum ResourceErrorOpenReadWrite = 7
    fromEnum ResourceErrorClose = 8
    fromEnum ResourceErrorRead = 9
    fromEnum ResourceErrorWrite = 10
    fromEnum ResourceErrorSeek = 11
    fromEnum ResourceErrorSync = 12
    fromEnum ResourceErrorSettings = 13
    fromEnum ResourceErrorNoSpaceLeft = 14
    fromEnum ResourceErrorNotAuthorized = 15
    fromEnum ResourceErrorNumErrors = 16
    fromEnum (AnotherResourceError k :: Int
k) = Int
k

    toEnum :: Int -> ResourceError
toEnum 1 = ResourceError
ResourceErrorFailed
    toEnum 2 = ResourceError
ResourceErrorTooLazy
    toEnum 3 = ResourceError
ResourceErrorNotFound
    toEnum 4 = ResourceError
ResourceErrorBusy
    toEnum 5 = ResourceError
ResourceErrorOpenRead
    toEnum 6 = ResourceError
ResourceErrorOpenWrite
    toEnum 7 = ResourceError
ResourceErrorOpenReadWrite
    toEnum 8 = ResourceError
ResourceErrorClose
    toEnum 9 = ResourceError
ResourceErrorRead
    toEnum 10 = ResourceError
ResourceErrorWrite
    toEnum 11 = ResourceError
ResourceErrorSeek
    toEnum 12 = ResourceError
ResourceErrorSync
    toEnum 13 = ResourceError
ResourceErrorSettings
    toEnum 14 = ResourceError
ResourceErrorNoSpaceLeft
    toEnum 15 = ResourceError
ResourceErrorNotAuthorized
    toEnum 16 = ResourceError
ResourceErrorNumErrors
    toEnum k :: Int
k = Int -> ResourceError
AnotherResourceError Int
k

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

instance GErrorClass ResourceError where
    gerrorClassDomain :: ResourceError -> Text
gerrorClassDomain _ = "gst-resource-error-quark"

-- | Catch exceptions of type `ResourceError`. This is a specialized version of `Data.GI.Base.GError.catchGErrorJustDomain`.
catchResourceError ::
    IO a ->
    (ResourceError -> GErrorMessage -> IO a) ->
    IO a
catchResourceError :: IO a -> (ResourceError -> Text -> IO a) -> IO a
catchResourceError = IO a -> (ResourceError -> Text -> IO a) -> IO a
forall err a.
GErrorClass err =>
IO a -> (err -> Text -> IO a) -> IO a
catchGErrorJustDomain

-- | Handle exceptions of type `ResourceError`. This is a specialized version of `Data.GI.Base.GError.handleGErrorJustDomain`.
handleResourceError ::
    (ResourceError -> GErrorMessage -> IO a) ->
    IO a ->
    IO a
handleResourceError :: (ResourceError -> Text -> IO a) -> IO a -> IO a
handleResourceError = (ResourceError -> Text -> IO a) -> IO a -> IO a
forall err a.
GErrorClass err =>
(err -> Text -> IO a) -> IO a -> IO a
handleGErrorJustDomain

foreign import ccall "gst_resource_error_get_type" c_gst_resource_error_get_type :: 
    IO GType

instance BoxedEnum ResourceError where
    boxedEnumType :: ResourceError -> IO GType
boxedEnumType _ = IO GType
c_gst_resource_error_get_type

-- Enum Rank
-- | Element priority ranks. Defines the order in which the autoplugger (or
-- similar rank-picking mechanisms, such as e.g. 'GI.Gst.Objects.Element.elementMakeFromUri')
-- will choose this element over an alternative one with the same function.
-- 
-- These constants serve as a rough guidance for defining the rank of a
-- t'GI.Gst.Objects.PluginFeature.PluginFeature'. Any value is valid, including values bigger than
-- /@gSTRANKPRIMARY@/.
data Rank = 
      RankNone
    -- ^ will be chosen last or not at all
    | RankMarginal
    -- ^ unlikely to be chosen
    | RankSecondary
    -- ^ likely to be chosen
    | RankPrimary
    -- ^ will be chosen first
    | AnotherRank Int
    -- ^ Catch-all for unknown values
    deriving (Int -> Rank -> ShowS
[Rank] -> ShowS
Rank -> String
(Int -> Rank -> ShowS)
-> (Rank -> String) -> ([Rank] -> ShowS) -> Show Rank
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rank] -> ShowS
$cshowList :: [Rank] -> ShowS
show :: Rank -> String
$cshow :: Rank -> String
showsPrec :: Int -> Rank -> ShowS
$cshowsPrec :: Int -> Rank -> ShowS
Show, Rank -> Rank -> Bool
(Rank -> Rank -> Bool) -> (Rank -> Rank -> Bool) -> Eq Rank
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rank -> Rank -> Bool
$c/= :: Rank -> Rank -> Bool
== :: Rank -> Rank -> Bool
$c== :: Rank -> Rank -> Bool
Eq)

instance P.Enum Rank where
    fromEnum :: Rank -> Int
fromEnum RankNone = 0
    fromEnum RankMarginal = 64
    fromEnum RankSecondary = 128
    fromEnum RankPrimary = 256
    fromEnum (AnotherRank k :: Int
k) = Int
k

    toEnum :: Int -> Rank
toEnum 0 = Rank
RankNone
    toEnum 64 = Rank
RankMarginal
    toEnum 128 = Rank
RankSecondary
    toEnum 256 = Rank
RankPrimary
    toEnum k :: Int
k = Int -> Rank
AnotherRank Int
k

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

foreign import ccall "gst_rank_get_type" c_gst_rank_get_type :: 
    IO GType

instance BoxedEnum Rank where
    boxedEnumType :: Rank -> IO GType
boxedEnumType _ = IO GType
c_gst_rank_get_type

-- Enum QueryType
-- | Standard predefined Query types
data QueryType = 
      QueryTypeUnknown
    -- ^ unknown query type
    | QueryTypePosition
    -- ^ current position in stream
    | QueryTypeDuration
    -- ^ total duration of the stream
    | QueryTypeLatency
    -- ^ latency of stream
    | QueryTypeJitter
    -- ^ current jitter of stream
    | QueryTypeRate
    -- ^ current rate of the stream
    | QueryTypeSeeking
    -- ^ seeking capabilities
    | QueryTypeSegment
    -- ^ segment start\/stop positions
    | QueryTypeConvert
    -- ^ convert values between formats
    | QueryTypeFormats
    -- ^ query supported formats for convert
    | QueryTypeBuffering
    -- ^ query available media for efficient seeking.
    | QueryTypeCustom
    -- ^ a custom application or element defined query.
    | QueryTypeUri
    -- ^ query the URI of the source or sink.
    | QueryTypeAllocation
    -- ^ the buffer allocation properties
    | QueryTypeScheduling
    -- ^ the scheduling properties
    | QueryTypeAcceptCaps
    -- ^ the accept caps query
    | QueryTypeCaps
    -- ^ the caps query
    | QueryTypeDrain
    -- ^ wait till all serialized data is consumed downstream
    | QueryTypeContext
    -- ^ query the pipeline-local context from
    --     downstream or upstream (since 1.2)
    | QueryTypeBitrate
    -- ^ the bitrate query (since 1.16)
    | AnotherQueryType Int
    -- ^ Catch-all for unknown values
    deriving (Int -> QueryType -> ShowS
[QueryType] -> ShowS
QueryType -> String
(Int -> QueryType -> ShowS)
-> (QueryType -> String)
-> ([QueryType] -> ShowS)
-> Show QueryType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QueryType] -> ShowS
$cshowList :: [QueryType] -> ShowS
show :: QueryType -> String
$cshow :: QueryType -> String
showsPrec :: Int -> QueryType -> ShowS
$cshowsPrec :: Int -> QueryType -> ShowS
Show, QueryType -> QueryType -> Bool
(QueryType -> QueryType -> Bool)
-> (QueryType -> QueryType -> Bool) -> Eq QueryType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QueryType -> QueryType -> Bool
$c/= :: QueryType -> QueryType -> Bool
== :: QueryType -> QueryType -> Bool
$c== :: QueryType -> QueryType -> Bool
Eq)

instance P.Enum QueryType where
    fromEnum :: QueryType -> Int
fromEnum QueryTypeUnknown = 0
    fromEnum QueryTypePosition = 2563
    fromEnum QueryTypeDuration = 5123
    fromEnum QueryTypeLatency = 7683
    fromEnum QueryTypeJitter = 10243
    fromEnum QueryTypeRate = 12803
    fromEnum QueryTypeSeeking = 15363
    fromEnum QueryTypeSegment = 17923
    fromEnum QueryTypeConvert = 20483
    fromEnum QueryTypeFormats = 23043
    fromEnum QueryTypeBuffering = 28163
    fromEnum QueryTypeCustom = 30723
    fromEnum QueryTypeUri = 33283
    fromEnum QueryTypeAllocation = 35846
    fromEnum QueryTypeScheduling = 38401
    fromEnum QueryTypeAcceptCaps = 40963
    fromEnum QueryTypeCaps = 43523
    fromEnum QueryTypeDrain = 46086
    fromEnum QueryTypeContext = 48643
    fromEnum QueryTypeBitrate = 51202
    fromEnum (AnotherQueryType k :: Int
k) = Int
k

    toEnum :: Int -> QueryType
toEnum 0 = QueryType
QueryTypeUnknown
    toEnum 2563 = QueryType
QueryTypePosition
    toEnum 5123 = QueryType
QueryTypeDuration
    toEnum 7683 = QueryType
QueryTypeLatency
    toEnum 10243 = QueryType
QueryTypeJitter
    toEnum 12803 = QueryType
QueryTypeRate
    toEnum 15363 = QueryType
QueryTypeSeeking
    toEnum 17923 = QueryType
QueryTypeSegment
    toEnum 20483 = QueryType
QueryTypeConvert
    toEnum 23043 = QueryType
QueryTypeFormats
    toEnum 28163 = QueryType
QueryTypeBuffering
    toEnum 30723 = QueryType
QueryTypeCustom
    toEnum 33283 = QueryType
QueryTypeUri
    toEnum 35846 = QueryType
QueryTypeAllocation
    toEnum 38401 = QueryType
QueryTypeScheduling
    toEnum 40963 = QueryType
QueryTypeAcceptCaps
    toEnum 43523 = QueryType
QueryTypeCaps
    toEnum 46086 = QueryType
QueryTypeDrain
    toEnum 48643 = QueryType
QueryTypeContext
    toEnum 51202 = QueryType
QueryTypeBitrate
    toEnum k :: Int
k = Int -> QueryType
AnotherQueryType Int
k

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

foreign import ccall "gst_query_type_get_type" c_gst_query_type_get_type :: 
    IO GType

instance BoxedEnum QueryType where
    boxedEnumType :: QueryType -> IO GType
boxedEnumType _ = IO GType
c_gst_query_type_get_type

-- Enum QOSType
-- | The different types of QoS events that can be given to the
-- 'GI.Gst.Structs.Event.eventNewQos' method.
data QOSType = 
      QOSTypeOverflow
    -- ^ The QoS event type that is produced when upstream
    --    elements are producing data too quickly and the element can\'t keep up
    --    processing the data. Upstream should reduce their production rate. This
    --    type is also used when buffers arrive early or in time.
    | QOSTypeUnderflow
    -- ^ The QoS event type that is produced when upstream
    --    elements are producing data too slowly and need to speed up their
    --    production rate.
    | QOSTypeThrottle
    -- ^ The QoS event type that is produced when the
    --    application enabled throttling to limit the data rate.
    | AnotherQOSType Int
    -- ^ Catch-all for unknown values
    deriving (Int -> QOSType -> ShowS
[QOSType] -> ShowS
QOSType -> String
(Int -> QOSType -> ShowS)
-> (QOSType -> String) -> ([QOSType] -> ShowS) -> Show QOSType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QOSType] -> ShowS
$cshowList :: [QOSType] -> ShowS
show :: QOSType -> String
$cshow :: QOSType -> String
showsPrec :: Int -> QOSType -> ShowS
$cshowsPrec :: Int -> QOSType -> ShowS
Show, QOSType -> QOSType -> Bool
(QOSType -> QOSType -> Bool)
-> (QOSType -> QOSType -> Bool) -> Eq QOSType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QOSType -> QOSType -> Bool
$c/= :: QOSType -> QOSType -> Bool
== :: QOSType -> QOSType -> Bool
$c== :: QOSType -> QOSType -> Bool
Eq)

instance P.Enum QOSType where
    fromEnum :: QOSType -> Int
fromEnum QOSTypeOverflow = 0
    fromEnum QOSTypeUnderflow = 1
    fromEnum QOSTypeThrottle = 2
    fromEnum (AnotherQOSType k :: Int
k) = Int
k

    toEnum :: Int -> QOSType
toEnum 0 = QOSType
QOSTypeOverflow
    toEnum 1 = QOSType
QOSTypeUnderflow
    toEnum 2 = QOSType
QOSTypeThrottle
    toEnum k :: Int
k = Int -> QOSType
AnotherQOSType Int
k

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

foreign import ccall "gst_qos_type_get_type" c_gst_qos_type_get_type :: 
    IO GType

instance BoxedEnum QOSType where
    boxedEnumType :: QOSType -> IO GType
boxedEnumType _ = IO GType
c_gst_qos_type_get_type

-- Enum PromiseResult
-- | The result of a t'GI.Gst.Structs.Promise.Promise'
-- 
-- /Since: 1.14/
data PromiseResult = 
      PromiseResultPending
    -- ^ Initial state. Waiting for transition to any
    -- 	other state.
    | PromiseResultInterrupted
    -- ^ Interrupted by the consumer as it doesn\'t
    -- 	want the value anymore.
    | PromiseResultReplied
    -- ^ A producer marked a reply
    | PromiseResultExpired
    -- ^ The promise expired (the carrying object
    -- 	lost all refs) and the promise will never be fulfilled.
    | AnotherPromiseResult Int
    -- ^ Catch-all for unknown values
    deriving (Int -> PromiseResult -> ShowS
[PromiseResult] -> ShowS
PromiseResult -> String
(Int -> PromiseResult -> ShowS)
-> (PromiseResult -> String)
-> ([PromiseResult] -> ShowS)
-> Show PromiseResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PromiseResult] -> ShowS
$cshowList :: [PromiseResult] -> ShowS
show :: PromiseResult -> String
$cshow :: PromiseResult -> String
showsPrec :: Int -> PromiseResult -> ShowS
$cshowsPrec :: Int -> PromiseResult -> ShowS
Show, PromiseResult -> PromiseResult -> Bool
(PromiseResult -> PromiseResult -> Bool)
-> (PromiseResult -> PromiseResult -> Bool) -> Eq PromiseResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PromiseResult -> PromiseResult -> Bool
$c/= :: PromiseResult -> PromiseResult -> Bool
== :: PromiseResult -> PromiseResult -> Bool
$c== :: PromiseResult -> PromiseResult -> Bool
Eq)

instance P.Enum PromiseResult where
    fromEnum :: PromiseResult -> Int
fromEnum PromiseResultPending = 0
    fromEnum PromiseResultInterrupted = 1
    fromEnum PromiseResultReplied = 2
    fromEnum PromiseResultExpired = 3
    fromEnum (AnotherPromiseResult k :: Int
k) = Int
k

    toEnum :: Int -> PromiseResult
toEnum 0 = PromiseResult
PromiseResultPending
    toEnum 1 = PromiseResult
PromiseResultInterrupted
    toEnum 2 = PromiseResult
PromiseResultReplied
    toEnum 3 = PromiseResult
PromiseResultExpired
    toEnum k :: Int
k = Int -> PromiseResult
AnotherPromiseResult Int
k

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

foreign import ccall "gst_promise_result_get_type" c_gst_promise_result_get_type :: 
    IO GType

instance BoxedEnum PromiseResult where
    boxedEnumType :: PromiseResult -> IO GType
boxedEnumType _ = IO GType
c_gst_promise_result_get_type

-- Enum ProgressType
-- | The type of a 'GI.Gst.Flags.MessageTypeProgress'. The progress messages inform the
-- application of the status of asynchronous tasks.
data ProgressType = 
      ProgressTypeStart
    -- ^ A new task started.
    | ProgressTypeContinue
    -- ^ A task completed and a new one continues.
    | ProgressTypeComplete
    -- ^ A task completed.
    | ProgressTypeCanceled
    -- ^ A task was canceled.
    | ProgressTypeError
    -- ^ A task caused an error. An error message is also
    --          posted on the bus.
    | AnotherProgressType Int
    -- ^ Catch-all for unknown values
    deriving (Int -> ProgressType -> ShowS
[ProgressType] -> ShowS
ProgressType -> String
(Int -> ProgressType -> ShowS)
-> (ProgressType -> String)
-> ([ProgressType] -> ShowS)
-> Show ProgressType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProgressType] -> ShowS
$cshowList :: [ProgressType] -> ShowS
show :: ProgressType -> String
$cshow :: ProgressType -> String
showsPrec :: Int -> ProgressType -> ShowS
$cshowsPrec :: Int -> ProgressType -> ShowS
Show, ProgressType -> ProgressType -> Bool
(ProgressType -> ProgressType -> Bool)
-> (ProgressType -> ProgressType -> Bool) -> Eq ProgressType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProgressType -> ProgressType -> Bool
$c/= :: ProgressType -> ProgressType -> Bool
== :: ProgressType -> ProgressType -> Bool
$c== :: ProgressType -> ProgressType -> Bool
Eq)

instance P.Enum ProgressType where
    fromEnum :: ProgressType -> Int
fromEnum ProgressTypeStart = 0
    fromEnum ProgressTypeContinue = 1
    fromEnum ProgressTypeComplete = 2
    fromEnum ProgressTypeCanceled = 3
    fromEnum ProgressTypeError = 4
    fromEnum (AnotherProgressType k :: Int
k) = Int
k

    toEnum :: Int -> ProgressType
toEnum 0 = ProgressType
ProgressTypeStart
    toEnum 1 = ProgressType
ProgressTypeContinue
    toEnum 2 = ProgressType
ProgressTypeComplete
    toEnum 3 = ProgressType
ProgressTypeCanceled
    toEnum 4 = ProgressType
ProgressTypeError
    toEnum k :: Int
k = Int -> ProgressType
AnotherProgressType Int
k

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

foreign import ccall "gst_progress_type_get_type" c_gst_progress_type_get_type :: 
    IO GType

instance BoxedEnum ProgressType where
    boxedEnumType :: ProgressType -> IO GType
boxedEnumType _ = IO GType
c_gst_progress_type_get_type

-- Enum PluginError
-- | The plugin loading errors
data PluginError = 
      PluginErrorModule
    -- ^ The plugin could not be loaded
    | PluginErrorDependencies
    -- ^ The plugin has unresolved dependencies
    | PluginErrorNameMismatch
    -- ^ The plugin has already be loaded from a different file
    | AnotherPluginError Int
    -- ^ Catch-all for unknown values
    deriving (Int -> PluginError -> ShowS
[PluginError] -> ShowS
PluginError -> String
(Int -> PluginError -> ShowS)
-> (PluginError -> String)
-> ([PluginError] -> ShowS)
-> Show PluginError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PluginError] -> ShowS
$cshowList :: [PluginError] -> ShowS
show :: PluginError -> String
$cshow :: PluginError -> String
showsPrec :: Int -> PluginError -> ShowS
$cshowsPrec :: Int -> PluginError -> ShowS
Show, PluginError -> PluginError -> Bool
(PluginError -> PluginError -> Bool)
-> (PluginError -> PluginError -> Bool) -> Eq PluginError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PluginError -> PluginError -> Bool
$c/= :: PluginError -> PluginError -> Bool
== :: PluginError -> PluginError -> Bool
$c== :: PluginError -> PluginError -> Bool
Eq)

instance P.Enum PluginError where
    fromEnum :: PluginError -> Int
fromEnum PluginErrorModule = 0
    fromEnum PluginErrorDependencies = 1
    fromEnum PluginErrorNameMismatch = 2
    fromEnum (AnotherPluginError k :: Int
k) = Int
k

    toEnum :: Int -> PluginError
toEnum 0 = PluginError
PluginErrorModule
    toEnum 1 = PluginError
PluginErrorDependencies
    toEnum 2 = PluginError
PluginErrorNameMismatch
    toEnum k :: Int
k = Int -> PluginError
AnotherPluginError Int
k

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

instance GErrorClass PluginError where
    gerrorClassDomain :: PluginError -> Text
gerrorClassDomain _ = "gst_plugin_error"

-- | Catch exceptions of type `PluginError`. This is a specialized version of `Data.GI.Base.GError.catchGErrorJustDomain`.
catchPluginError ::
    IO a ->
    (PluginError -> GErrorMessage -> IO a) ->
    IO a
catchPluginError :: IO a -> (PluginError -> Text -> IO a) -> IO a
catchPluginError = IO a -> (PluginError -> Text -> IO a) -> IO a
forall err a.
GErrorClass err =>
IO a -> (err -> Text -> IO a) -> IO a
catchGErrorJustDomain

-- | Handle exceptions of type `PluginError`. This is a specialized version of `Data.GI.Base.GError.handleGErrorJustDomain`.
handlePluginError ::
    (PluginError -> GErrorMessage -> IO a) ->
    IO a ->
    IO a
handlePluginError :: (PluginError -> Text -> IO a) -> IO a -> IO a
handlePluginError = (PluginError -> Text -> IO a) -> IO a -> IO a
forall err a.
GErrorClass err =>
(err -> Text -> IO a) -> IO a -> IO a
handleGErrorJustDomain

foreign import ccall "gst_plugin_error_get_type" c_gst_plugin_error_get_type :: 
    IO GType

instance BoxedEnum PluginError where
    boxedEnumType :: PluginError -> IO GType
boxedEnumType _ = IO GType
c_gst_plugin_error_get_type

-- Enum ParseError
-- | The different parsing errors that can occur.
data ParseError = 
      ParseErrorSyntax
    -- ^ A syntax error occurred.
    | ParseErrorNoSuchElement
    -- ^ The description contained an unknown element
    | ParseErrorNoSuchProperty
    -- ^ An element did not have a specified property
    | ParseErrorLink
    -- ^ There was an error linking two pads.
    | ParseErrorCouldNotSetProperty
    -- ^ There was an error setting a property
    | ParseErrorEmptyBin
    -- ^ An empty bin was specified.
    | ParseErrorEmpty
    -- ^ An empty description was specified
    | ParseErrorDelayedLink
    -- ^ A delayed link did not get resolved.
    | AnotherParseError Int
    -- ^ Catch-all for unknown values
    deriving (Int -> ParseError -> ShowS
[ParseError] -> ShowS
ParseError -> String
(Int -> ParseError -> ShowS)
-> (ParseError -> String)
-> ([ParseError] -> ShowS)
-> Show ParseError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParseError] -> ShowS
$cshowList :: [ParseError] -> ShowS
show :: ParseError -> String
$cshow :: ParseError -> String
showsPrec :: Int -> ParseError -> ShowS
$cshowsPrec :: Int -> ParseError -> ShowS
Show, ParseError -> ParseError -> Bool
(ParseError -> ParseError -> Bool)
-> (ParseError -> ParseError -> Bool) -> Eq ParseError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParseError -> ParseError -> Bool
$c/= :: ParseError -> ParseError -> Bool
== :: ParseError -> ParseError -> Bool
$c== :: ParseError -> ParseError -> Bool
Eq)

instance P.Enum ParseError where
    fromEnum :: ParseError -> Int
fromEnum ParseErrorSyntax = 0
    fromEnum ParseErrorNoSuchElement = 1
    fromEnum ParseErrorNoSuchProperty = 2
    fromEnum ParseErrorLink = 3
    fromEnum ParseErrorCouldNotSetProperty = 4
    fromEnum ParseErrorEmptyBin = 5
    fromEnum ParseErrorEmpty = 6
    fromEnum ParseErrorDelayedLink = 7
    fromEnum (AnotherParseError k :: Int
k) = Int
k

    toEnum :: Int -> ParseError
toEnum 0 = ParseError
ParseErrorSyntax
    toEnum 1 = ParseError
ParseErrorNoSuchElement
    toEnum 2 = ParseError
ParseErrorNoSuchProperty
    toEnum 3 = ParseError
ParseErrorLink
    toEnum 4 = ParseError
ParseErrorCouldNotSetProperty
    toEnum 5 = ParseError
ParseErrorEmptyBin
    toEnum 6 = ParseError
ParseErrorEmpty
    toEnum 7 = ParseError
ParseErrorDelayedLink
    toEnum k :: Int
k = Int -> ParseError
AnotherParseError Int
k

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

instance GErrorClass ParseError where
    gerrorClassDomain :: ParseError -> Text
gerrorClassDomain _ = "gst_parse_error"

-- | Catch exceptions of type `ParseError`. This is a specialized version of `Data.GI.Base.GError.catchGErrorJustDomain`.
catchParseError ::
    IO a ->
    (ParseError -> GErrorMessage -> IO a) ->
    IO a
catchParseError :: IO a -> (ParseError -> Text -> IO a) -> IO a
catchParseError = IO a -> (ParseError -> Text -> IO a) -> IO a
forall err a.
GErrorClass err =>
IO a -> (err -> Text -> IO a) -> IO a
catchGErrorJustDomain

-- | Handle exceptions of type `ParseError`. This is a specialized version of `Data.GI.Base.GError.handleGErrorJustDomain`.
handleParseError ::
    (ParseError -> GErrorMessage -> IO a) ->
    IO a ->
    IO a
handleParseError :: (ParseError -> Text -> IO a) -> IO a -> IO a
handleParseError = (ParseError -> Text -> IO a) -> IO a -> IO a
forall err a.
GErrorClass err =>
(err -> Text -> IO a) -> IO a -> IO a
handleGErrorJustDomain

foreign import ccall "gst_parse_error_get_type" c_gst_parse_error_get_type :: 
    IO GType

instance BoxedEnum ParseError where
    boxedEnumType :: ParseError -> IO GType
boxedEnumType _ = IO GType
c_gst_parse_error_get_type

-- Enum PadProbeReturn
-- | Different return values for the t'GI.Gst.Callbacks.PadProbeCallback'.
data PadProbeReturn = 
      PadProbeReturnDrop
    -- ^ drop data in data probes. For push mode this means that
    --        the data item is not sent downstream. For pull mode, it means that
    --        the data item is not passed upstream. In both cases, no other probes
    --        are called for this item and 'GI.Gst.Enums.FlowReturnOk' or 'P.True' is returned to the
    --        caller.
    | PadProbeReturnOk
    -- ^ normal probe return value. This leaves the probe in
    --        place, and defers decisions about dropping or passing data to other
    --        probes, if any. If there are no other probes, the default behaviour
    --        for the probe type applies (\'block\' for blocking probes,
    --        and \'pass\' for non-blocking probes).
    | PadProbeReturnRemove
    -- ^ remove this probe.
    | PadProbeReturnPass
    -- ^ pass the data item in the block probe and block on the
    --        next item.
    | PadProbeReturnHandled
    -- ^ Data has been handled in the probe and will not be
    --        forwarded further. For events and buffers this is the same behaviour as
    --        'GI.Gst.Enums.PadProbeReturnDrop' (except that in this case you need to unref the buffer
    --        or event yourself). For queries it will also return 'P.True' to the caller.
    --        The probe can also modify the t'GI.Gst.Enums.FlowReturn' value by using the
    --        @/GST_PAD_PROBE_INFO_FLOW_RETURN/@() accessor.
    --        Note that the resulting query must contain valid entries.
    --        Since: 1.6
    | AnotherPadProbeReturn Int
    -- ^ Catch-all for unknown values
    deriving (Int -> PadProbeReturn -> ShowS
[PadProbeReturn] -> ShowS
PadProbeReturn -> String
(Int -> PadProbeReturn -> ShowS)
-> (PadProbeReturn -> String)
-> ([PadProbeReturn] -> ShowS)
-> Show PadProbeReturn
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PadProbeReturn] -> ShowS
$cshowList :: [PadProbeReturn] -> ShowS
show :: PadProbeReturn -> String
$cshow :: PadProbeReturn -> String
showsPrec :: Int -> PadProbeReturn -> ShowS
$cshowsPrec :: Int -> PadProbeReturn -> ShowS
Show, PadProbeReturn -> PadProbeReturn -> Bool
(PadProbeReturn -> PadProbeReturn -> Bool)
-> (PadProbeReturn -> PadProbeReturn -> Bool) -> Eq PadProbeReturn
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PadProbeReturn -> PadProbeReturn -> Bool
$c/= :: PadProbeReturn -> PadProbeReturn -> Bool
== :: PadProbeReturn -> PadProbeReturn -> Bool
$c== :: PadProbeReturn -> PadProbeReturn -> Bool
Eq)

instance P.Enum PadProbeReturn where
    fromEnum :: PadProbeReturn -> Int
fromEnum PadProbeReturnDrop = 0
    fromEnum PadProbeReturnOk = 1
    fromEnum PadProbeReturnRemove = 2
    fromEnum PadProbeReturnPass = 3
    fromEnum PadProbeReturnHandled = 4
    fromEnum (AnotherPadProbeReturn k :: Int
k) = Int
k

    toEnum :: Int -> PadProbeReturn
toEnum 0 = PadProbeReturn
PadProbeReturnDrop
    toEnum 1 = PadProbeReturn
PadProbeReturnOk
    toEnum 2 = PadProbeReturn
PadProbeReturnRemove
    toEnum 3 = PadProbeReturn
PadProbeReturnPass
    toEnum 4 = PadProbeReturn
PadProbeReturnHandled
    toEnum k :: Int
k = Int -> PadProbeReturn
AnotherPadProbeReturn Int
k

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

foreign import ccall "gst_pad_probe_return_get_type" c_gst_pad_probe_return_get_type :: 
    IO GType

instance BoxedEnum PadProbeReturn where
    boxedEnumType :: PadProbeReturn -> IO GType
boxedEnumType _ = IO GType
c_gst_pad_probe_return_get_type

-- Enum PadPresence
-- | Indicates when this pad will become available.
data PadPresence = 
      PadPresenceAlways
    -- ^ the pad is always available
    | PadPresenceSometimes
    -- ^ the pad will become available depending on the media stream
    | PadPresenceRequest
    -- ^ the pad is only available on request with
    --  'GI.Gst.Objects.Element.elementRequestPad'.
    | AnotherPadPresence Int
    -- ^ Catch-all for unknown values
    deriving (Int -> PadPresence -> ShowS
[PadPresence] -> ShowS
PadPresence -> String
(Int -> PadPresence -> ShowS)
-> (PadPresence -> String)
-> ([PadPresence] -> ShowS)
-> Show PadPresence
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PadPresence] -> ShowS
$cshowList :: [PadPresence] -> ShowS
show :: PadPresence -> String
$cshow :: PadPresence -> String
showsPrec :: Int -> PadPresence -> ShowS
$cshowsPrec :: Int -> PadPresence -> ShowS
Show, PadPresence -> PadPresence -> Bool
(PadPresence -> PadPresence -> Bool)
-> (PadPresence -> PadPresence -> Bool) -> Eq PadPresence
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PadPresence -> PadPresence -> Bool
$c/= :: PadPresence -> PadPresence -> Bool
== :: PadPresence -> PadPresence -> Bool
$c== :: PadPresence -> PadPresence -> Bool
Eq)

instance P.Enum PadPresence where
    fromEnum :: PadPresence -> Int
fromEnum PadPresenceAlways = 0
    fromEnum PadPresenceSometimes = 1
    fromEnum PadPresenceRequest = 2
    fromEnum (AnotherPadPresence k :: Int
k) = Int
k

    toEnum :: Int -> PadPresence
toEnum 0 = PadPresence
PadPresenceAlways
    toEnum 1 = PadPresence
PadPresenceSometimes
    toEnum 2 = PadPresence
PadPresenceRequest
    toEnum k :: Int
k = Int -> PadPresence
AnotherPadPresence Int
k

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

foreign import ccall "gst_pad_presence_get_type" c_gst_pad_presence_get_type :: 
    IO GType

instance BoxedEnum PadPresence where
    boxedEnumType :: PadPresence -> IO GType
boxedEnumType _ = IO GType
c_gst_pad_presence_get_type

-- Enum PadMode
-- | The status of a GstPad. After activating a pad, which usually happens when the
-- parent element goes from READY to PAUSED, the GstPadMode defines if the
-- pad operates in push or pull mode.
data PadMode = 
      PadModeNone
    -- ^ Pad will not handle dataflow
    | PadModePush
    -- ^ Pad handles dataflow in downstream push mode
    | PadModePull
    -- ^ Pad handles dataflow in upstream pull mode
    | AnotherPadMode Int
    -- ^ Catch-all for unknown values
    deriving (Int -> PadMode -> ShowS
[PadMode] -> ShowS
PadMode -> String
(Int -> PadMode -> ShowS)
-> (PadMode -> String) -> ([PadMode] -> ShowS) -> Show PadMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PadMode] -> ShowS
$cshowList :: [PadMode] -> ShowS
show :: PadMode -> String
$cshow :: PadMode -> String
showsPrec :: Int -> PadMode -> ShowS
$cshowsPrec :: Int -> PadMode -> ShowS
Show, PadMode -> PadMode -> Bool
(PadMode -> PadMode -> Bool)
-> (PadMode -> PadMode -> Bool) -> Eq PadMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PadMode -> PadMode -> Bool
$c/= :: PadMode -> PadMode -> Bool
== :: PadMode -> PadMode -> Bool
$c== :: PadMode -> PadMode -> Bool
Eq)

instance P.Enum PadMode where
    fromEnum :: PadMode -> Int
fromEnum PadModeNone = 0
    fromEnum PadModePush = 1
    fromEnum PadModePull = 2
    fromEnum (AnotherPadMode k :: Int
k) = Int
k

    toEnum :: Int -> PadMode
toEnum 0 = PadMode
PadModeNone
    toEnum 1 = PadMode
PadModePush
    toEnum 2 = PadMode
PadModePull
    toEnum k :: Int
k = Int -> PadMode
AnotherPadMode Int
k

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

foreign import ccall "gst_pad_mode_get_type" c_gst_pad_mode_get_type :: 
    IO GType

instance BoxedEnum PadMode where
    boxedEnumType :: PadMode -> IO GType
boxedEnumType _ = IO GType
c_gst_pad_mode_get_type

-- Enum PadLinkReturn
-- | Result values from gst_pad_link and friends.
data PadLinkReturn = 
      PadLinkReturnOk
    -- ^ link succeeded
    | PadLinkReturnWrongHierarchy
    -- ^ pads have no common grandparent
    | PadLinkReturnWasLinked
    -- ^ pad was already linked
    | PadLinkReturnWrongDirection
    -- ^ pads have wrong direction
    | PadLinkReturnNoformat
    -- ^ pads do not have common format
    | PadLinkReturnNosched
    -- ^ pads cannot cooperate in scheduling
    | PadLinkReturnRefused
    -- ^ refused for some reason
    | AnotherPadLinkReturn Int
    -- ^ Catch-all for unknown values
    deriving (Int -> PadLinkReturn -> ShowS
[PadLinkReturn] -> ShowS
PadLinkReturn -> String
(Int -> PadLinkReturn -> ShowS)
-> (PadLinkReturn -> String)
-> ([PadLinkReturn] -> ShowS)
-> Show PadLinkReturn
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PadLinkReturn] -> ShowS
$cshowList :: [PadLinkReturn] -> ShowS
show :: PadLinkReturn -> String
$cshow :: PadLinkReturn -> String
showsPrec :: Int -> PadLinkReturn -> ShowS
$cshowsPrec :: Int -> PadLinkReturn -> ShowS
Show, PadLinkReturn -> PadLinkReturn -> Bool
(PadLinkReturn -> PadLinkReturn -> Bool)
-> (PadLinkReturn -> PadLinkReturn -> Bool) -> Eq PadLinkReturn
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PadLinkReturn -> PadLinkReturn -> Bool
$c/= :: PadLinkReturn -> PadLinkReturn -> Bool
== :: PadLinkReturn -> PadLinkReturn -> Bool
$c== :: PadLinkReturn -> PadLinkReturn -> Bool
Eq)

instance P.Enum PadLinkReturn where
    fromEnum :: PadLinkReturn -> Int
fromEnum PadLinkReturnOk = 0
    fromEnum PadLinkReturnWrongHierarchy = -1
    fromEnum PadLinkReturnWasLinked = -2
    fromEnum PadLinkReturnWrongDirection = -3
    fromEnum PadLinkReturnNoformat = -4
    fromEnum PadLinkReturnNosched = -5
    fromEnum PadLinkReturnRefused = -6
    fromEnum (AnotherPadLinkReturn k :: Int
k) = Int
k

    toEnum :: Int -> PadLinkReturn
toEnum 0 = PadLinkReturn
PadLinkReturnOk
    toEnum -1 = PadLinkReturn
PadLinkReturnWrongHierarchy
    toEnum -2 = PadLinkReturn
PadLinkReturnWasLinked
    toEnum -3 = PadLinkReturn
PadLinkReturnWrongDirection
    toEnum -4 = PadLinkReturn
PadLinkReturnNoformat
    toEnum -5 = PadLinkReturn
PadLinkReturnNosched
    toEnum -6 = PadLinkReturn
PadLinkReturnRefused
    toEnum k :: Int
k = Int -> PadLinkReturn
AnotherPadLinkReturn Int
k

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

foreign import ccall "gst_pad_link_return_get_type" c_gst_pad_link_return_get_type :: 
    IO GType

instance BoxedEnum PadLinkReturn where
    boxedEnumType :: PadLinkReturn -> IO GType
boxedEnumType _ = IO GType
c_gst_pad_link_return_get_type

-- Enum PadDirection
-- | The direction of a pad.
data PadDirection = 
      PadDirectionUnknown
    -- ^ direction is unknown.
    | PadDirectionSrc
    -- ^ the pad is a source pad.
    | PadDirectionSink
    -- ^ the pad is a sink pad.
    | AnotherPadDirection Int
    -- ^ Catch-all for unknown values
    deriving (Int -> PadDirection -> ShowS
[PadDirection] -> ShowS
PadDirection -> String
(Int -> PadDirection -> ShowS)
-> (PadDirection -> String)
-> ([PadDirection] -> ShowS)
-> Show PadDirection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PadDirection] -> ShowS
$cshowList :: [PadDirection] -> ShowS
show :: PadDirection -> String
$cshow :: PadDirection -> String
showsPrec :: Int -> PadDirection -> ShowS
$cshowsPrec :: Int -> PadDirection -> ShowS
Show, PadDirection -> PadDirection -> Bool
(PadDirection -> PadDirection -> Bool)
-> (PadDirection -> PadDirection -> Bool) -> Eq PadDirection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PadDirection -> PadDirection -> Bool
$c/= :: PadDirection -> PadDirection -> Bool
== :: PadDirection -> PadDirection -> Bool
$c== :: PadDirection -> PadDirection -> Bool
Eq)

instance P.Enum PadDirection where
    fromEnum :: PadDirection -> Int
fromEnum PadDirectionUnknown = 0
    fromEnum PadDirectionSrc = 1
    fromEnum PadDirectionSink = 2
    fromEnum (AnotherPadDirection k :: Int
k) = Int
k

    toEnum :: Int -> PadDirection
toEnum 0 = PadDirection
PadDirectionUnknown
    toEnum 1 = PadDirection
PadDirectionSrc
    toEnum 2 = PadDirection
PadDirectionSink
    toEnum k :: Int
k = Int -> PadDirection
AnotherPadDirection Int
k

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

foreign import ccall "gst_pad_direction_get_type" c_gst_pad_direction_get_type :: 
    IO GType

instance BoxedEnum PadDirection where
    boxedEnumType :: PadDirection -> IO GType
boxedEnumType _ = IO GType
c_gst_pad_direction_get_type

-- Enum LibraryError
-- | Library errors are for errors from the library being used by elements
-- (initializing, finalizing, settings, ...)
data LibraryError = 
      LibraryErrorFailed
    -- ^ a general error which doesn\'t fit in any other
    -- category.  Make sure you add a custom message to the error call.
    | LibraryErrorTooLazy
    -- ^ do not use this except as a placeholder for
    -- deciding where to go while developing code.
    | LibraryErrorInit
    -- ^ used when the library could not be opened.
    | LibraryErrorShutdown
    -- ^ used when the library could not be closed.
    | LibraryErrorSettings
    -- ^ used when the library doesn\'t accept settings.
    | LibraryErrorEncode
    -- ^ used when the library generated an encoding error.
    | LibraryErrorNumErrors
    -- ^ the number of library error types.
    | AnotherLibraryError Int
    -- ^ Catch-all for unknown values
    deriving (Int -> LibraryError -> ShowS
[LibraryError] -> ShowS
LibraryError -> String
(Int -> LibraryError -> ShowS)
-> (LibraryError -> String)
-> ([LibraryError] -> ShowS)
-> Show LibraryError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LibraryError] -> ShowS
$cshowList :: [LibraryError] -> ShowS
show :: LibraryError -> String
$cshow :: LibraryError -> String
showsPrec :: Int -> LibraryError -> ShowS
$cshowsPrec :: Int -> LibraryError -> ShowS
Show, LibraryError -> LibraryError -> Bool
(LibraryError -> LibraryError -> Bool)
-> (LibraryError -> LibraryError -> Bool) -> Eq LibraryError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LibraryError -> LibraryError -> Bool
$c/= :: LibraryError -> LibraryError -> Bool
== :: LibraryError -> LibraryError -> Bool
$c== :: LibraryError -> LibraryError -> Bool
Eq)

instance P.Enum LibraryError where
    fromEnum :: LibraryError -> Int
fromEnum LibraryErrorFailed = 1
    fromEnum LibraryErrorTooLazy = 2
    fromEnum LibraryErrorInit = 3
    fromEnum LibraryErrorShutdown = 4
    fromEnum LibraryErrorSettings = 5
    fromEnum LibraryErrorEncode = 6
    fromEnum LibraryErrorNumErrors = 7
    fromEnum (AnotherLibraryError k :: Int
k) = Int
k

    toEnum :: Int -> LibraryError
toEnum 1 = LibraryError
LibraryErrorFailed
    toEnum 2 = LibraryError
LibraryErrorTooLazy
    toEnum 3 = LibraryError
LibraryErrorInit
    toEnum 4 = LibraryError
LibraryErrorShutdown
    toEnum 5 = LibraryError
LibraryErrorSettings
    toEnum 6 = LibraryError
LibraryErrorEncode
    toEnum 7 = LibraryError
LibraryErrorNumErrors
    toEnum k :: Int
k = Int -> LibraryError
AnotherLibraryError Int
k

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

instance GErrorClass LibraryError where
    gerrorClassDomain :: LibraryError -> Text
gerrorClassDomain _ = "gst-library-error-quark"

-- | Catch exceptions of type `LibraryError`. This is a specialized version of `Data.GI.Base.GError.catchGErrorJustDomain`.
catchLibraryError ::
    IO a ->
    (LibraryError -> GErrorMessage -> IO a) ->
    IO a
catchLibraryError :: IO a -> (LibraryError -> Text -> IO a) -> IO a
catchLibraryError = IO a -> (LibraryError -> Text -> IO a) -> IO a
forall err a.
GErrorClass err =>
IO a -> (err -> Text -> IO a) -> IO a
catchGErrorJustDomain

-- | Handle exceptions of type `LibraryError`. This is a specialized version of `Data.GI.Base.GError.handleGErrorJustDomain`.
handleLibraryError ::
    (LibraryError -> GErrorMessage -> IO a) ->
    IO a ->
    IO a
handleLibraryError :: (LibraryError -> Text -> IO a) -> IO a -> IO a
handleLibraryError = (LibraryError -> Text -> IO a) -> IO a -> IO a
forall err a.
GErrorClass err =>
(err -> Text -> IO a) -> IO a -> IO a
handleGErrorJustDomain

foreign import ccall "gst_library_error_get_type" c_gst_library_error_get_type :: 
    IO GType

instance BoxedEnum LibraryError where
    boxedEnumType :: LibraryError -> IO GType
boxedEnumType _ = IO GType
c_gst_library_error_get_type

-- Enum IteratorResult
-- | The result of 'GI.Gst.Structs.Iterator.iteratorNext'.
data IteratorResult = 
      IteratorResultDone
    -- ^ No more items in the iterator
    | IteratorResultOk
    -- ^ An item was retrieved
    | IteratorResultResync
    -- ^ Datastructure changed while iterating
    | IteratorResultError
    -- ^ An error happened
    | AnotherIteratorResult Int
    -- ^ Catch-all for unknown values
    deriving (Int -> IteratorResult -> ShowS
[IteratorResult] -> ShowS
IteratorResult -> String
(Int -> IteratorResult -> ShowS)
-> (IteratorResult -> String)
-> ([IteratorResult] -> ShowS)
-> Show IteratorResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IteratorResult] -> ShowS
$cshowList :: [IteratorResult] -> ShowS
show :: IteratorResult -> String
$cshow :: IteratorResult -> String
showsPrec :: Int -> IteratorResult -> ShowS
$cshowsPrec :: Int -> IteratorResult -> ShowS
Show, IteratorResult -> IteratorResult -> Bool
(IteratorResult -> IteratorResult -> Bool)
-> (IteratorResult -> IteratorResult -> Bool) -> Eq IteratorResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IteratorResult -> IteratorResult -> Bool
$c/= :: IteratorResult -> IteratorResult -> Bool
== :: IteratorResult -> IteratorResult -> Bool
$c== :: IteratorResult -> IteratorResult -> Bool
Eq)

instance P.Enum IteratorResult where
    fromEnum :: IteratorResult -> Int
fromEnum IteratorResultDone = 0
    fromEnum IteratorResultOk = 1
    fromEnum IteratorResultResync = 2
    fromEnum IteratorResultError = 3
    fromEnum (AnotherIteratorResult k :: Int
k) = Int
k

    toEnum :: Int -> IteratorResult
toEnum 0 = IteratorResult
IteratorResultDone
    toEnum 1 = IteratorResult
IteratorResultOk
    toEnum 2 = IteratorResult
IteratorResultResync
    toEnum 3 = IteratorResult
IteratorResultError
    toEnum k :: Int
k = Int -> IteratorResult
AnotherIteratorResult Int
k

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

foreign import ccall "gst_iterator_result_get_type" c_gst_iterator_result_get_type :: 
    IO GType

instance BoxedEnum IteratorResult where
    boxedEnumType :: IteratorResult -> IO GType
boxedEnumType _ = IO GType
c_gst_iterator_result_get_type

-- Enum IteratorItem
-- | The result of a t'GI.Gst.Callbacks.IteratorItemFunction'.
data IteratorItem = 
      IteratorItemSkip
    -- ^ Skip this item
    | IteratorItemPass
    -- ^ Return item
    | IteratorItemEnd
    -- ^ Stop after this item.
    | AnotherIteratorItem Int
    -- ^ Catch-all for unknown values
    deriving (Int -> IteratorItem -> ShowS
[IteratorItem] -> ShowS
IteratorItem -> String
(Int -> IteratorItem -> ShowS)
-> (IteratorItem -> String)
-> ([IteratorItem] -> ShowS)
-> Show IteratorItem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IteratorItem] -> ShowS
$cshowList :: [IteratorItem] -> ShowS
show :: IteratorItem -> String
$cshow :: IteratorItem -> String
showsPrec :: Int -> IteratorItem -> ShowS
$cshowsPrec :: Int -> IteratorItem -> ShowS
Show, IteratorItem -> IteratorItem -> Bool
(IteratorItem -> IteratorItem -> Bool)
-> (IteratorItem -> IteratorItem -> Bool) -> Eq IteratorItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IteratorItem -> IteratorItem -> Bool
$c/= :: IteratorItem -> IteratorItem -> Bool
== :: IteratorItem -> IteratorItem -> Bool
$c== :: IteratorItem -> IteratorItem -> Bool
Eq)

instance P.Enum IteratorItem where
    fromEnum :: IteratorItem -> Int
fromEnum IteratorItemSkip = 0
    fromEnum IteratorItemPass = 1
    fromEnum IteratorItemEnd = 2
    fromEnum (AnotherIteratorItem k :: Int
k) = Int
k

    toEnum :: Int -> IteratorItem
toEnum 0 = IteratorItem
IteratorItemSkip
    toEnum 1 = IteratorItem
IteratorItemPass
    toEnum 2 = IteratorItem
IteratorItemEnd
    toEnum k :: Int
k = Int -> IteratorItem
AnotherIteratorItem Int
k

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

foreign import ccall "gst_iterator_item_get_type" c_gst_iterator_item_get_type :: 
    IO GType

instance BoxedEnum IteratorItem where
    boxedEnumType :: IteratorItem -> IO GType
boxedEnumType _ = IO GType
c_gst_iterator_item_get_type

-- Enum Format
-- | Standard predefined formats
data Format = 
      FormatUndefined
    -- ^ undefined format
    | FormatDefault
    -- ^ the default format of the pad\/element. This can be
    --    samples for raw audio, frames\/fields for raw video (some, but not all,
    --    elements support this; use /@gSTFORMATTIME@/ if you don\'t have a good
    --    reason to query for samples\/frames)
    | FormatBytes
    -- ^ bytes
    | FormatTime
    -- ^ time in nanoseconds
    | FormatBuffers
    -- ^ buffers (few, if any, elements implement this as of
    --     May 2009)
    | FormatPercent
    -- ^ percentage of stream (few, if any, elements implement
    --     this as of May 2009)
    | AnotherFormat Int
    -- ^ Catch-all for unknown values
    deriving (Int -> Format -> ShowS
[Format] -> ShowS
Format -> String
(Int -> Format -> ShowS)
-> (Format -> String) -> ([Format] -> ShowS) -> Show Format
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Format] -> ShowS
$cshowList :: [Format] -> ShowS
show :: Format -> String
$cshow :: Format -> String
showsPrec :: Int -> Format -> ShowS
$cshowsPrec :: Int -> Format -> ShowS
Show, Format -> Format -> Bool
(Format -> Format -> Bool)
-> (Format -> Format -> Bool) -> Eq Format
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Format -> Format -> Bool
$c/= :: Format -> Format -> Bool
== :: Format -> Format -> Bool
$c== :: Format -> Format -> Bool
Eq)

instance P.Enum Format where
    fromEnum :: Format -> Int
fromEnum FormatUndefined = 0
    fromEnum FormatDefault = 1
    fromEnum FormatBytes = 2
    fromEnum FormatTime = 3
    fromEnum FormatBuffers = 4
    fromEnum FormatPercent = 5
    fromEnum (AnotherFormat k :: Int
k) = Int
k

    toEnum :: Int -> Format
toEnum 0 = Format
FormatUndefined
    toEnum 1 = Format
FormatDefault
    toEnum 2 = Format
FormatBytes
    toEnum 3 = Format
FormatTime
    toEnum 4 = Format
FormatBuffers
    toEnum 5 = Format
FormatPercent
    toEnum k :: Int
k = Int -> Format
AnotherFormat Int
k

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

foreign import ccall "gst_format_get_type" c_gst_format_get_type :: 
    IO GType

instance BoxedEnum Format where
    boxedEnumType :: Format -> IO GType
boxedEnumType _ = IO GType
c_gst_format_get_type

-- Enum FlowReturn
-- | The result of passing data to a pad.
-- 
-- Note that the custom return values should not be exposed outside of the
-- element scope.
data FlowReturn = 
      FlowReturnCustomSuccess2
    -- ^ Pre-defined custom success code.
    | FlowReturnCustomSuccess1
    -- ^ Pre-defined custom success code (define your
    --                               custom success code to this to avoid compiler
    --                               warnings).
    | FlowReturnCustomSuccess
    -- ^ Elements can use values starting from
    --                               this (and higher) to define custom success
    --                               codes.
    | FlowReturnOk
    -- ^ Data passing was ok.
    | FlowReturnNotLinked
    -- ^ Pad is not linked.
    | FlowReturnFlushing
    -- ^ Pad is flushing.
    | FlowReturnEos
    -- ^ Pad is EOS.
    | FlowReturnNotNegotiated
    -- ^ Pad is not negotiated.
    | FlowReturnError
    -- ^ Some (fatal) error occurred. Element generating
    --                               this error should post an error message with more
    --                               details.
    | FlowReturnNotSupported
    -- ^ This operation is not supported.
    | FlowReturnCustomError
    -- ^ Elements can use values starting from
    --                               this (and lower) to define custom error codes.
    | FlowReturnCustomError1
    -- ^ Pre-defined custom error code (define your
    --                               custom error code to this to avoid compiler
    --                               warnings).
    | FlowReturnCustomError2
    -- ^ Pre-defined custom error code.
    | AnotherFlowReturn Int
    -- ^ Catch-all for unknown values
    deriving (Int -> FlowReturn -> ShowS
[FlowReturn] -> ShowS
FlowReturn -> String
(Int -> FlowReturn -> ShowS)
-> (FlowReturn -> String)
-> ([FlowReturn] -> ShowS)
-> Show FlowReturn
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FlowReturn] -> ShowS
$cshowList :: [FlowReturn] -> ShowS
show :: FlowReturn -> String
$cshow :: FlowReturn -> String
showsPrec :: Int -> FlowReturn -> ShowS
$cshowsPrec :: Int -> FlowReturn -> ShowS
Show, FlowReturn -> FlowReturn -> Bool
(FlowReturn -> FlowReturn -> Bool)
-> (FlowReturn -> FlowReturn -> Bool) -> Eq FlowReturn
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FlowReturn -> FlowReturn -> Bool
$c/= :: FlowReturn -> FlowReturn -> Bool
== :: FlowReturn -> FlowReturn -> Bool
$c== :: FlowReturn -> FlowReturn -> Bool
Eq)

instance P.Enum FlowReturn where
    fromEnum :: FlowReturn -> Int
fromEnum FlowReturnCustomSuccess2 = 102
    fromEnum FlowReturnCustomSuccess1 = 101
    fromEnum FlowReturnCustomSuccess = 100
    fromEnum FlowReturnOk = 0
    fromEnum FlowReturnNotLinked = -1
    fromEnum FlowReturnFlushing = -2
    fromEnum FlowReturnEos = -3
    fromEnum FlowReturnNotNegotiated = -4
    fromEnum FlowReturnError = -5
    fromEnum FlowReturnNotSupported = -6
    fromEnum FlowReturnCustomError = -100
    fromEnum FlowReturnCustomError1 = -101
    fromEnum FlowReturnCustomError2 = -102
    fromEnum (AnotherFlowReturn k :: Int
k) = Int
k

    toEnum :: Int -> FlowReturn
toEnum 102 = FlowReturn
FlowReturnCustomSuccess2
    toEnum 101 = FlowReturn
FlowReturnCustomSuccess1
    toEnum 100 = FlowReturn
FlowReturnCustomSuccess
    toEnum 0 = FlowReturn
FlowReturnOk
    toEnum -1 = FlowReturn
FlowReturnNotLinked
    toEnum -2 = FlowReturn
FlowReturnFlushing
    toEnum -3 = FlowReturn
FlowReturnEos
    toEnum -4 = FlowReturn
FlowReturnNotNegotiated
    toEnum -5 = FlowReturn
FlowReturnError
    toEnum -6 = FlowReturn
FlowReturnNotSupported
    toEnum -100 = FlowReturn
FlowReturnCustomError
    toEnum -101 = FlowReturn
FlowReturnCustomError1
    toEnum -102 = FlowReturn
FlowReturnCustomError2
    toEnum k :: Int
k = Int -> FlowReturn
AnotherFlowReturn Int
k

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

foreign import ccall "gst_flow_return_get_type" c_gst_flow_return_get_type :: 
    IO GType

instance BoxedEnum FlowReturn where
    boxedEnumType :: FlowReturn -> IO GType
boxedEnumType _ = IO GType
c_gst_flow_return_get_type

-- Enum EventType
-- | t'GI.Gst.Enums.EventType' lists the standard event types that can be sent in a pipeline.
-- 
-- The custom event types can be used for private messages between elements
-- that can\'t be expressed using normal
-- GStreamer buffer passing semantics. Custom events carry an arbitrary
-- t'GI.Gst.Structs.Structure.Structure'.
-- Specific custom events are distinguished by the name of the structure.
data EventType = 
      EventTypeUnknown
    -- ^ unknown event.
    | EventTypeFlushStart
    -- ^ Start a flush operation. This event clears all data
    --                 from the pipeline and unblock all streaming threads.
    | EventTypeFlushStop
    -- ^ Stop a flush operation. This event resets the
    --                 running-time of the pipeline.
    | EventTypeStreamStart
    -- ^ Event to mark the start of a new stream. Sent before any
    --                 other serialized event and only sent at the start of a new stream,
    --                 not after flushing seeks.
    | EventTypeCaps
    -- ^ t'GI.Gst.Structs.Caps.Caps' event. Notify the pad of a new media type.
    | EventTypeSegment
    -- ^ A new media segment follows in the dataflow. The
    --                 segment events contains information for clipping buffers and
    --                 converting buffer timestamps to running-time and
    --                 stream-time.
    | EventTypeStreamCollection
    -- ^ A new t'GI.Gst.Objects.StreamCollection.StreamCollection' is available (Since 1.10)
    | EventTypeTag
    -- ^ A new set of metadata tags has been found in the stream.
    | EventTypeBuffersize
    -- ^ Notification of buffering requirements. Currently not
    --                 used yet.
    | EventTypeSinkMessage
    -- ^ An event that sinks turn into a message. Used to
    --                          send messages that should be emitted in sync with
    --                          rendering.
    | EventTypeStreamGroupDone
    -- ^ Indicates that there is no more data for
    --                 the stream group ID in the message. Sent before EOS
    --                 in some instances and should be handled mostly the same. (Since 1.10)
    | EventTypeEos
    -- ^ End-Of-Stream. No more data is to be expected to follow
    --                 without either a STREAM_START event, or a FLUSH_STOP and a SEGMENT
    --                 event.
    | EventTypeToc
    -- ^ An event which indicates that a new table of contents (TOC)
    --                 was found or updated.
    | EventTypeProtection
    -- ^ An event which indicates that new or updated
    --                 encryption information has been found in the stream.
    | EventTypeSegmentDone
    -- ^ Marks the end of a segment playback.
    | EventTypeGap
    -- ^ Marks a gap in the datastream.
    | EventTypeQos
    -- ^ A quality message. Used to indicate to upstream elements
    --                 that the downstream elements should adjust their processing
    --                 rate.
    | EventTypeSeek
    -- ^ A request for a new playback position and rate.
    | EventTypeNavigation
    -- ^ Navigation events are usually used for communicating
    --                        user requests, such as mouse or keyboard movements,
    --                        to upstream elements.
    | EventTypeLatency
    -- ^ Notification of new latency adjustment. Sinks will use
    --                     the latency information to adjust their synchronisation.
    | EventTypeStep
    -- ^ A request for stepping through the media. Sinks will usually
    --                  execute the step operation.
    | EventTypeReconfigure
    -- ^ A request for upstream renegotiating caps and reconfiguring.
    | EventTypeTocSelect
    -- ^ A request for a new playback position based on TOC
    --                        entry\'s UID.
    | EventTypeSelectStreams
    -- ^ A request to select one or more streams (Since 1.10)
    | EventTypeCustomUpstream
    -- ^ Upstream custom event
    | EventTypeCustomDownstream
    -- ^ Downstream custom event that travels in the
    --                        data flow.
    | EventTypeCustomDownstreamOob
    -- ^ Custom out-of-band downstream event.
    | EventTypeCustomDownstreamSticky
    -- ^ Custom sticky downstream event.
    | EventTypeCustomBoth
    -- ^ Custom upstream or downstream event.
    --                         In-band when travelling downstream.
    | EventTypeCustomBothOob
    -- ^ Custom upstream or downstream out-of-band event.
    | AnotherEventType Int
    -- ^ Catch-all for unknown values
    deriving (Int -> EventType -> ShowS
[EventType] -> ShowS
EventType -> String
(Int -> EventType -> ShowS)
-> (EventType -> String)
-> ([EventType] -> ShowS)
-> Show EventType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EventType] -> ShowS
$cshowList :: [EventType] -> ShowS
show :: EventType -> String
$cshow :: EventType -> String
showsPrec :: Int -> EventType -> ShowS
$cshowsPrec :: Int -> EventType -> ShowS
Show, EventType -> EventType -> Bool
(EventType -> EventType -> Bool)
-> (EventType -> EventType -> Bool) -> Eq EventType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EventType -> EventType -> Bool
$c/= :: EventType -> EventType -> Bool
== :: EventType -> EventType -> Bool
$c== :: EventType -> EventType -> Bool
Eq)

instance P.Enum EventType where
    fromEnum :: EventType -> Int
fromEnum EventTypeUnknown = 0
    fromEnum EventTypeFlushStart = 2563
    fromEnum EventTypeFlushStop = 5127
    fromEnum EventTypeStreamStart = 10254
    fromEnum EventTypeCaps = 12814
    fromEnum EventTypeSegment = 17934
    fromEnum EventTypeStreamCollection = 19230
    fromEnum EventTypeTag = 20510
    fromEnum EventTypeBuffersize = 23054
    fromEnum EventTypeSinkMessage = 25630
    fromEnum EventTypeStreamGroupDone = 26894
    fromEnum EventTypeEos = 28174
    fromEnum EventTypeToc = 30750
    fromEnum EventTypeProtection = 33310
    fromEnum EventTypeSegmentDone = 38406
    fromEnum EventTypeGap = 40966
    fromEnum EventTypeQos = 48641
    fromEnum EventTypeSeek = 51201
    fromEnum EventTypeNavigation = 53761
    fromEnum EventTypeLatency = 56321
    fromEnum EventTypeStep = 58881
    fromEnum EventTypeReconfigure = 61441
    fromEnum EventTypeTocSelect = 64001
    fromEnum EventTypeSelectStreams = 66561
    fromEnum EventTypeCustomUpstream = 69121
    fromEnum EventTypeCustomDownstream = 71686
    fromEnum EventTypeCustomDownstreamOob = 74242
    fromEnum EventTypeCustomDownstreamSticky = 76830
    fromEnum EventTypeCustomBoth = 79367
    fromEnum EventTypeCustomBothOob = 81923
    fromEnum (AnotherEventType k :: Int
k) = Int
k

    toEnum :: Int -> EventType
toEnum 0 = EventType
EventTypeUnknown
    toEnum 2563 = EventType
EventTypeFlushStart
    toEnum 5127 = EventType
EventTypeFlushStop
    toEnum 10254 = EventType
EventTypeStreamStart
    toEnum 12814 = EventType
EventTypeCaps
    toEnum 17934 = EventType
EventTypeSegment
    toEnum 19230 = EventType
EventTypeStreamCollection
    toEnum 20510 = EventType
EventTypeTag
    toEnum 23054 = EventType
EventTypeBuffersize
    toEnum 25630 = EventType
EventTypeSinkMessage
    toEnum 26894 = EventType
EventTypeStreamGroupDone
    toEnum 28174 = EventType
EventTypeEos
    toEnum 30750 = EventType
EventTypeToc
    toEnum 33310 = EventType
EventTypeProtection
    toEnum 38406 = EventType
EventTypeSegmentDone
    toEnum 40966 = EventType
EventTypeGap
    toEnum 48641 = EventType
EventTypeQos
    toEnum 51201 = EventType
EventTypeSeek
    toEnum 53761 = EventType
EventTypeNavigation
    toEnum 56321 = EventType
EventTypeLatency
    toEnum 58881 = EventType
EventTypeStep
    toEnum 61441 = EventType
EventTypeReconfigure
    toEnum 64001 = EventType
EventTypeTocSelect
    toEnum 66561 = EventType
EventTypeSelectStreams
    toEnum 69121 = EventType
EventTypeCustomUpstream
    toEnum 71686 = EventType
EventTypeCustomDownstream
    toEnum 74242 = EventType
EventTypeCustomDownstreamOob
    toEnum 76830 = EventType
EventTypeCustomDownstreamSticky
    toEnum 79367 = EventType
EventTypeCustomBoth
    toEnum 81923 = EventType
EventTypeCustomBothOob
    toEnum k :: Int
k = Int -> EventType
AnotherEventType Int
k

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

foreign import ccall "gst_event_type_get_type" c_gst_event_type_get_type :: 
    IO GType

instance BoxedEnum EventType where
    boxedEnumType :: EventType -> IO GType
boxedEnumType _ = IO GType
c_gst_event_type_get_type

-- Enum DebugLevel
-- | The level defines the importance of a debugging message. The more important a
-- message is, the greater the probability that the debugging system outputs it.
data DebugLevel = 
      DebugLevelNone
    -- ^ No debugging level specified or desired. Used to deactivate
    --  debugging output.
    | DebugLevelError
    -- ^ Error messages are to be used only when an error occurred
    --  that stops the application from keeping working correctly.
    --  An examples is gst_element_error, which outputs a message with this priority.
    --  It does not mean that the application is terminating as with g_error.
    | DebugLevelWarning
    -- ^ Warning messages are to inform about abnormal behaviour
    --  that could lead to problems or weird behaviour later on. An example of this
    --  would be clocking issues (\"your computer is pretty slow\") or broken input
    --  data (\"Can\'t synchronize to stream.\")
    | DebugLevelFixme
    -- ^ Fixme messages are messages that indicate that something
    --  in the executed code path is not fully implemented or handled yet. Note
    --  that this does not replace proper error handling in any way, the purpose
    --  of this message is to make it easier to spot incomplete\/unfinished pieces
    --  of code when reading the debug log.
    | DebugLevelInfo
    -- ^ Informational messages should be used to keep the developer
    --  updated about what is happening.
    --  Examples where this should be used are when a typefind function has
    --  successfully determined the type of the stream or when an mp3 plugin detects
    --  the format to be used. (\"This file has mono sound.\")
    | DebugLevelDebug
    -- ^ Debugging messages should be used when something common
    --  happens that is not the expected default behavior, or something that\'s
    --  useful to know but doesn\'t happen all the time (ie. per loop iteration or
    --  buffer processed or event handled).
    --  An example would be notifications about state changes or receiving\/sending
    --  of events.
    | DebugLevelLog
    -- ^ Log messages are messages that are very common but might be
    --  useful to know. As a rule of thumb a pipeline that is running as expected
    --  should never output anything else but LOG messages whilst processing data.
    --  Use this log level to log recurring information in chain functions and
    --  loop functions, for example.
    | DebugLevelTrace
    -- ^ Tracing-related messages.
    --  Examples for this are referencing\/dereferencing of objects.
    | DebugLevelMemdump
    -- ^ memory dump messages are used to log (small) chunks of
    --  data as memory dumps in the log. They will be displayed as hexdump with
    --  ASCII characters.
    | DebugLevelCount
    -- ^ The number of defined debugging levels.
    | AnotherDebugLevel Int
    -- ^ Catch-all for unknown values
    deriving (Int -> DebugLevel -> ShowS
[DebugLevel] -> ShowS
DebugLevel -> String
(Int -> DebugLevel -> ShowS)
-> (DebugLevel -> String)
-> ([DebugLevel] -> ShowS)
-> Show DebugLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DebugLevel] -> ShowS
$cshowList :: [DebugLevel] -> ShowS
show :: DebugLevel -> String
$cshow :: DebugLevel -> String
showsPrec :: Int -> DebugLevel -> ShowS
$cshowsPrec :: Int -> DebugLevel -> ShowS
Show, DebugLevel -> DebugLevel -> Bool
(DebugLevel -> DebugLevel -> Bool)
-> (DebugLevel -> DebugLevel -> Bool) -> Eq DebugLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DebugLevel -> DebugLevel -> Bool
$c/= :: DebugLevel -> DebugLevel -> Bool
== :: DebugLevel -> DebugLevel -> Bool
$c== :: DebugLevel -> DebugLevel -> Bool
Eq)

instance P.Enum DebugLevel where
    fromEnum :: DebugLevel -> Int
fromEnum DebugLevelNone = 0
    fromEnum DebugLevelError = 1
    fromEnum DebugLevelWarning = 2
    fromEnum DebugLevelFixme = 3
    fromEnum DebugLevelInfo = 4
    fromEnum DebugLevelDebug = 5
    fromEnum DebugLevelLog = 6
    fromEnum DebugLevelTrace = 7
    fromEnum DebugLevelMemdump = 9
    fromEnum DebugLevelCount = 10
    fromEnum (AnotherDebugLevel k :: Int
k) = Int
k

    toEnum :: Int -> DebugLevel
toEnum 0 = DebugLevel
DebugLevelNone
    toEnum 1 = DebugLevel
DebugLevelError
    toEnum 2 = DebugLevel
DebugLevelWarning
    toEnum 3 = DebugLevel
DebugLevelFixme
    toEnum 4 = DebugLevel
DebugLevelInfo
    toEnum 5 = DebugLevel
DebugLevelDebug
    toEnum 6 = DebugLevel
DebugLevelLog
    toEnum 7 = DebugLevel
DebugLevelTrace
    toEnum 9 = DebugLevel
DebugLevelMemdump
    toEnum 10 = DebugLevel
DebugLevelCount
    toEnum k :: Int
k = Int -> DebugLevel
AnotherDebugLevel Int
k

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

foreign import ccall "gst_debug_level_get_type" c_gst_debug_level_get_type :: 
    IO GType

instance BoxedEnum DebugLevel where
    boxedEnumType :: DebugLevel -> IO GType
boxedEnumType _ = IO GType
c_gst_debug_level_get_type

-- Enum DebugColorMode
-- | /No description available in the introspection data./
data DebugColorMode = 
      DebugColorModeOff
    -- ^ Do not use colors in logs.
    | DebugColorModeOn
    -- ^ Paint logs in a platform-specific way.
    | DebugColorModeUnix
    -- ^ Paint logs with UNIX terminal color codes
    --                             no matter what platform GStreamer is running on.
    | AnotherDebugColorMode Int
    -- ^ Catch-all for unknown values
    deriving (Int -> DebugColorMode -> ShowS
[DebugColorMode] -> ShowS
DebugColorMode -> String
(Int -> DebugColorMode -> ShowS)
-> (DebugColorMode -> String)
-> ([DebugColorMode] -> ShowS)
-> Show DebugColorMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DebugColorMode] -> ShowS
$cshowList :: [DebugColorMode] -> ShowS
show :: DebugColorMode -> String
$cshow :: DebugColorMode -> String
showsPrec :: Int -> DebugColorMode -> ShowS
$cshowsPrec :: Int -> DebugColorMode -> ShowS
Show, DebugColorMode -> DebugColorMode -> Bool
(DebugColorMode -> DebugColorMode -> Bool)
-> (DebugColorMode -> DebugColorMode -> Bool) -> Eq DebugColorMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DebugColorMode -> DebugColorMode -> Bool
$c/= :: DebugColorMode -> DebugColorMode -> Bool
== :: DebugColorMode -> DebugColorMode -> Bool
$c== :: DebugColorMode -> DebugColorMode -> Bool
Eq)

instance P.Enum DebugColorMode where
    fromEnum :: DebugColorMode -> Int
fromEnum DebugColorModeOff = 0
    fromEnum DebugColorModeOn = 1
    fromEnum DebugColorModeUnix = 2
    fromEnum (AnotherDebugColorMode k :: Int
k) = Int
k

    toEnum :: Int -> DebugColorMode
toEnum 0 = DebugColorMode
DebugColorModeOff
    toEnum 1 = DebugColorMode
DebugColorModeOn
    toEnum 2 = DebugColorMode
DebugColorModeUnix
    toEnum k :: Int
k = Int -> DebugColorMode
AnotherDebugColorMode Int
k

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

foreign import ccall "gst_debug_color_mode_get_type" c_gst_debug_color_mode_get_type :: 
    IO GType

instance BoxedEnum DebugColorMode where
    boxedEnumType :: DebugColorMode -> IO GType
boxedEnumType _ = IO GType
c_gst_debug_color_mode_get_type

-- Enum CoreError
-- | Core errors are errors inside the core GStreamer library.
data CoreError = 
      CoreErrorFailed
    -- ^ a general error which doesn\'t fit in any other
    -- category.  Make sure you add a custom message to the error call.
    | CoreErrorTooLazy
    -- ^ do not use this except as a placeholder for
    -- deciding where to go while developing code.
    | CoreErrorNotImplemented
    -- ^ use this when you do not want to implement
    -- this functionality yet.
    | CoreErrorStateChange
    -- ^ used for state change errors.
    | CoreErrorPad
    -- ^ used for pad-related errors.
    | CoreErrorThread
    -- ^ used for thread-related errors.
    | CoreErrorNegotiation
    -- ^ used for negotiation-related errors.
    | CoreErrorEvent
    -- ^ used for event-related errors.
    | CoreErrorSeek
    -- ^ used for seek-related errors.
    | CoreErrorCaps
    -- ^ used for caps-related errors.
    | CoreErrorTag
    -- ^ used for negotiation-related errors.
    | CoreErrorMissingPlugin
    -- ^ used if a plugin is missing.
    | CoreErrorClock
    -- ^ used for clock related errors.
    | CoreErrorDisabled
    -- ^ used if functionality has been disabled at
    --                           compile time.
    | CoreErrorNumErrors
    -- ^ the number of core error types.
    | AnotherCoreError Int
    -- ^ Catch-all for unknown values
    deriving (Int -> CoreError -> ShowS
[CoreError] -> ShowS
CoreError -> String
(Int -> CoreError -> ShowS)
-> (CoreError -> String)
-> ([CoreError] -> ShowS)
-> Show CoreError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CoreError] -> ShowS
$cshowList :: [CoreError] -> ShowS
show :: CoreError -> String
$cshow :: CoreError -> String
showsPrec :: Int -> CoreError -> ShowS
$cshowsPrec :: Int -> CoreError -> ShowS
Show, CoreError -> CoreError -> Bool
(CoreError -> CoreError -> Bool)
-> (CoreError -> CoreError -> Bool) -> Eq CoreError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CoreError -> CoreError -> Bool
$c/= :: CoreError -> CoreError -> Bool
== :: CoreError -> CoreError -> Bool
$c== :: CoreError -> CoreError -> Bool
Eq)

instance P.Enum CoreError where
    fromEnum :: CoreError -> Int
fromEnum CoreErrorFailed = 1
    fromEnum CoreErrorTooLazy = 2
    fromEnum CoreErrorNotImplemented = 3
    fromEnum CoreErrorStateChange = 4
    fromEnum CoreErrorPad = 5
    fromEnum CoreErrorThread = 6
    fromEnum CoreErrorNegotiation = 7
    fromEnum CoreErrorEvent = 8
    fromEnum CoreErrorSeek = 9
    fromEnum CoreErrorCaps = 10
    fromEnum CoreErrorTag = 11
    fromEnum CoreErrorMissingPlugin = 12
    fromEnum CoreErrorClock = 13
    fromEnum CoreErrorDisabled = 14
    fromEnum CoreErrorNumErrors = 15
    fromEnum (AnotherCoreError k :: Int
k) = Int
k

    toEnum :: Int -> CoreError
toEnum 1 = CoreError
CoreErrorFailed
    toEnum 2 = CoreError
CoreErrorTooLazy
    toEnum 3 = CoreError
CoreErrorNotImplemented
    toEnum 4 = CoreError
CoreErrorStateChange
    toEnum 5 = CoreError
CoreErrorPad
    toEnum 6 = CoreError
CoreErrorThread
    toEnum 7 = CoreError
CoreErrorNegotiation
    toEnum 8 = CoreError
CoreErrorEvent
    toEnum 9 = CoreError
CoreErrorSeek
    toEnum 10 = CoreError
CoreErrorCaps
    toEnum 11 = CoreError
CoreErrorTag
    toEnum 12 = CoreError
CoreErrorMissingPlugin
    toEnum 13 = CoreError
CoreErrorClock
    toEnum 14 = CoreError
CoreErrorDisabled
    toEnum 15 = CoreError
CoreErrorNumErrors
    toEnum k :: Int
k = Int -> CoreError
AnotherCoreError Int
k

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

instance GErrorClass CoreError where
    gerrorClassDomain :: CoreError -> Text
gerrorClassDomain _ = "gst-core-error-quark"

-- | Catch exceptions of type `CoreError`. This is a specialized version of `Data.GI.Base.GError.catchGErrorJustDomain`.
catchCoreError ::
    IO a ->
    (CoreError -> GErrorMessage -> IO a) ->
    IO a
catchCoreError :: IO a -> (CoreError -> Text -> IO a) -> IO a
catchCoreError = IO a -> (CoreError -> Text -> IO a) -> IO a
forall err a.
GErrorClass err =>
IO a -> (err -> Text -> IO a) -> IO a
catchGErrorJustDomain

-- | Handle exceptions of type `CoreError`. This is a specialized version of `Data.GI.Base.GError.handleGErrorJustDomain`.
handleCoreError ::
    (CoreError -> GErrorMessage -> IO a) ->
    IO a ->
    IO a
handleCoreError :: (CoreError -> Text -> IO a) -> IO a -> IO a
handleCoreError = (CoreError -> Text -> IO a) -> IO a -> IO a
forall err a.
GErrorClass err =>
(err -> Text -> IO a) -> IO a -> IO a
handleGErrorJustDomain

foreign import ccall "gst_core_error_get_type" c_gst_core_error_get_type :: 
    IO GType

instance BoxedEnum CoreError where
    boxedEnumType :: CoreError -> IO GType
boxedEnumType _ = IO GType
c_gst_core_error_get_type

-- Enum ClockType
-- | The different kind of clocks.
data ClockType = 
      ClockTypeRealtime
    -- ^ time since Epoch
    | ClockTypeMonotonic
    -- ^ monotonic time since some unspecified starting
    --                            point
    | ClockTypeOther
    -- ^ some other time source is used (Since 1.0.5)
    | AnotherClockType Int
    -- ^ Catch-all for unknown values
    deriving (Int -> ClockType -> ShowS
[ClockType] -> ShowS
ClockType -> String
(Int -> ClockType -> ShowS)
-> (ClockType -> String)
-> ([ClockType] -> ShowS)
-> Show ClockType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClockType] -> ShowS
$cshowList :: [ClockType] -> ShowS
show :: ClockType -> String
$cshow :: ClockType -> String
showsPrec :: Int -> ClockType -> ShowS
$cshowsPrec :: Int -> ClockType -> ShowS
Show, ClockType -> ClockType -> Bool
(ClockType -> ClockType -> Bool)
-> (ClockType -> ClockType -> Bool) -> Eq ClockType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClockType -> ClockType -> Bool
$c/= :: ClockType -> ClockType -> Bool
== :: ClockType -> ClockType -> Bool
$c== :: ClockType -> ClockType -> Bool
Eq)

instance P.Enum ClockType where
    fromEnum :: ClockType -> Int
fromEnum ClockTypeRealtime = 0
    fromEnum ClockTypeMonotonic = 1
    fromEnum ClockTypeOther = 2
    fromEnum (AnotherClockType k :: Int
k) = Int
k

    toEnum :: Int -> ClockType
toEnum 0 = ClockType
ClockTypeRealtime
    toEnum 1 = ClockType
ClockTypeMonotonic
    toEnum 2 = ClockType
ClockTypeOther
    toEnum k :: Int
k = Int -> ClockType
AnotherClockType Int
k

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

foreign import ccall "gst_clock_type_get_type" c_gst_clock_type_get_type :: 
    IO GType

instance BoxedEnum ClockType where
    boxedEnumType :: ClockType -> IO GType
boxedEnumType _ = IO GType
c_gst_clock_type_get_type

-- Enum ClockReturn
-- | The return value of a clock operation.
data ClockReturn = 
      ClockReturnOk
    -- ^ The operation succeeded.
    | ClockReturnEarly
    -- ^ The operation was scheduled too late.
    | ClockReturnUnscheduled
    -- ^ The clockID was unscheduled
    | ClockReturnBusy
    -- ^ The ClockID is busy
    | ClockReturnBadtime
    -- ^ A bad time was provided to a function.
    | ClockReturnError
    -- ^ An error occurred
    | ClockReturnUnsupported
    -- ^ Operation is not supported
    | ClockReturnDone
    -- ^ The ClockID is done waiting
    | AnotherClockReturn Int
    -- ^ Catch-all for unknown values
    deriving (Int -> ClockReturn -> ShowS
[ClockReturn] -> ShowS
ClockReturn -> String
(Int -> ClockReturn -> ShowS)
-> (ClockReturn -> String)
-> ([ClockReturn] -> ShowS)
-> Show ClockReturn
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClockReturn] -> ShowS
$cshowList :: [ClockReturn] -> ShowS
show :: ClockReturn -> String
$cshow :: ClockReturn -> String
showsPrec :: Int -> ClockReturn -> ShowS
$cshowsPrec :: Int -> ClockReturn -> ShowS
Show, ClockReturn -> ClockReturn -> Bool
(ClockReturn -> ClockReturn -> Bool)
-> (ClockReturn -> ClockReturn -> Bool) -> Eq ClockReturn
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClockReturn -> ClockReturn -> Bool
$c/= :: ClockReturn -> ClockReturn -> Bool
== :: ClockReturn -> ClockReturn -> Bool
$c== :: ClockReturn -> ClockReturn -> Bool
Eq)

instance P.Enum ClockReturn where
    fromEnum :: ClockReturn -> Int
fromEnum ClockReturnOk = 0
    fromEnum ClockReturnEarly = 1
    fromEnum ClockReturnUnscheduled = 2
    fromEnum ClockReturnBusy = 3
    fromEnum ClockReturnBadtime = 4
    fromEnum ClockReturnError = 5
    fromEnum ClockReturnUnsupported = 6
    fromEnum ClockReturnDone = 7
    fromEnum (AnotherClockReturn k :: Int
k) = Int
k

    toEnum :: Int -> ClockReturn
toEnum 0 = ClockReturn
ClockReturnOk
    toEnum 1 = ClockReturn
ClockReturnEarly
    toEnum 2 = ClockReturn
ClockReturnUnscheduled
    toEnum 3 = ClockReturn
ClockReturnBusy
    toEnum 4 = ClockReturn
ClockReturnBadtime
    toEnum 5 = ClockReturn
ClockReturnError
    toEnum 6 = ClockReturn
ClockReturnUnsupported
    toEnum 7 = ClockReturn
ClockReturnDone
    toEnum k :: Int
k = Int -> ClockReturn
AnotherClockReturn Int
k

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

foreign import ccall "gst_clock_return_get_type" c_gst_clock_return_get_type :: 
    IO GType

instance BoxedEnum ClockReturn where
    boxedEnumType :: ClockReturn -> IO GType
boxedEnumType _ = IO GType
c_gst_clock_return_get_type

-- Enum ClockEntryType
-- | The type of the clock entry
data ClockEntryType = 
      ClockEntryTypeSingle
    -- ^ a single shot timeout
    | ClockEntryTypePeriodic
    -- ^ a periodic timeout request
    | AnotherClockEntryType Int
    -- ^ Catch-all for unknown values
    deriving (Int -> ClockEntryType -> ShowS
[ClockEntryType] -> ShowS
ClockEntryType -> String
(Int -> ClockEntryType -> ShowS)
-> (ClockEntryType -> String)
-> ([ClockEntryType] -> ShowS)
-> Show ClockEntryType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClockEntryType] -> ShowS
$cshowList :: [ClockEntryType] -> ShowS
show :: ClockEntryType -> String
$cshow :: ClockEntryType -> String
showsPrec :: Int -> ClockEntryType -> ShowS
$cshowsPrec :: Int -> ClockEntryType -> ShowS
Show, ClockEntryType -> ClockEntryType -> Bool
(ClockEntryType -> ClockEntryType -> Bool)
-> (ClockEntryType -> ClockEntryType -> Bool) -> Eq ClockEntryType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClockEntryType -> ClockEntryType -> Bool
$c/= :: ClockEntryType -> ClockEntryType -> Bool
== :: ClockEntryType -> ClockEntryType -> Bool
$c== :: ClockEntryType -> ClockEntryType -> Bool
Eq)

instance P.Enum ClockEntryType where
    fromEnum :: ClockEntryType -> Int
fromEnum ClockEntryTypeSingle = 0
    fromEnum ClockEntryTypePeriodic = 1
    fromEnum (AnotherClockEntryType k :: Int
k) = Int
k

    toEnum :: Int -> ClockEntryType
toEnum 0 = ClockEntryType
ClockEntryTypeSingle
    toEnum 1 = ClockEntryType
ClockEntryTypePeriodic
    toEnum k :: Int
k = Int -> ClockEntryType
AnotherClockEntryType Int
k

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

foreign import ccall "gst_clock_entry_type_get_type" c_gst_clock_entry_type_get_type :: 
    IO GType

instance BoxedEnum ClockEntryType where
    boxedEnumType :: ClockEntryType -> IO GType
boxedEnumType _ = IO GType
c_gst_clock_entry_type_get_type

-- Enum CapsIntersectMode
-- | Modes of caps intersection
-- 
-- /@gSTCAPSINTERSECTZIGZAG@/ tries to preserve overall order of both caps
-- by iterating on the caps\' structures as the following matrix shows:
-- >
-- >         caps1
-- >      +-------------
-- >      | 1  2  4  7
-- >caps2 | 3  5  8 10
-- >      | 6  9 11 12
-- 
-- Used when there is no explicit precedence of one caps over the other. e.g.
-- tee\'s sink pad getcaps function, it will probe its src pad peers\' for their
-- caps and intersect them with this mode.
-- 
-- /@gSTCAPSINTERSECTFIRST@/ is useful when an element wants to preserve
-- another element\'s caps priority order when intersecting with its own caps.
-- Example: If caps1 is [A, B, C] and caps2 is [E, B, D, A], the result
-- would be [A, B], maintaining the first caps priority on the intersection.
data CapsIntersectMode = 
      CapsIntersectModeZigZag
    -- ^ Zig-zags over both caps.
    | CapsIntersectModeFirst
    -- ^ Keeps the first caps order.
    | AnotherCapsIntersectMode Int
    -- ^ Catch-all for unknown values
    deriving (Int -> CapsIntersectMode -> ShowS
[CapsIntersectMode] -> ShowS
CapsIntersectMode -> String
(Int -> CapsIntersectMode -> ShowS)
-> (CapsIntersectMode -> String)
-> ([CapsIntersectMode] -> ShowS)
-> Show CapsIntersectMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CapsIntersectMode] -> ShowS
$cshowList :: [CapsIntersectMode] -> ShowS
show :: CapsIntersectMode -> String
$cshow :: CapsIntersectMode -> String
showsPrec :: Int -> CapsIntersectMode -> ShowS
$cshowsPrec :: Int -> CapsIntersectMode -> ShowS
Show, CapsIntersectMode -> CapsIntersectMode -> Bool
(CapsIntersectMode -> CapsIntersectMode -> Bool)
-> (CapsIntersectMode -> CapsIntersectMode -> Bool)
-> Eq CapsIntersectMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CapsIntersectMode -> CapsIntersectMode -> Bool
$c/= :: CapsIntersectMode -> CapsIntersectMode -> Bool
== :: CapsIntersectMode -> CapsIntersectMode -> Bool
$c== :: CapsIntersectMode -> CapsIntersectMode -> Bool
Eq)

instance P.Enum CapsIntersectMode where
    fromEnum :: CapsIntersectMode -> Int
fromEnum CapsIntersectModeZigZag = 0
    fromEnum CapsIntersectModeFirst = 1
    fromEnum (AnotherCapsIntersectMode k :: Int
k) = Int
k

    toEnum :: Int -> CapsIntersectMode
toEnum 0 = CapsIntersectMode
CapsIntersectModeZigZag
    toEnum 1 = CapsIntersectMode
CapsIntersectModeFirst
    toEnum k :: Int
k = Int -> CapsIntersectMode
AnotherCapsIntersectMode Int
k

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

foreign import ccall "gst_caps_intersect_mode_get_type" c_gst_caps_intersect_mode_get_type :: 
    IO GType

instance BoxedEnum CapsIntersectMode where
    boxedEnumType :: CapsIntersectMode -> IO GType
boxedEnumType _ = IO GType
c_gst_caps_intersect_mode_get_type

-- Enum BusSyncReply
-- | The result values for a GstBusSyncHandler.
data BusSyncReply = 
      BusSyncReplyDrop
    -- ^ drop the message
    | BusSyncReplyPass
    -- ^ pass the message to the async queue
    | BusSyncReplyAsync
    -- ^ pass message to async queue, continue if message is handled
    | AnotherBusSyncReply Int
    -- ^ Catch-all for unknown values
    deriving (Int -> BusSyncReply -> ShowS
[BusSyncReply] -> ShowS
BusSyncReply -> String
(Int -> BusSyncReply -> ShowS)
-> (BusSyncReply -> String)
-> ([BusSyncReply] -> ShowS)
-> Show BusSyncReply
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BusSyncReply] -> ShowS
$cshowList :: [BusSyncReply] -> ShowS
show :: BusSyncReply -> String
$cshow :: BusSyncReply -> String
showsPrec :: Int -> BusSyncReply -> ShowS
$cshowsPrec :: Int -> BusSyncReply -> ShowS
Show, BusSyncReply -> BusSyncReply -> Bool
(BusSyncReply -> BusSyncReply -> Bool)
-> (BusSyncReply -> BusSyncReply -> Bool) -> Eq BusSyncReply
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BusSyncReply -> BusSyncReply -> Bool
$c/= :: BusSyncReply -> BusSyncReply -> Bool
== :: BusSyncReply -> BusSyncReply -> Bool
$c== :: BusSyncReply -> BusSyncReply -> Bool
Eq)

instance P.Enum BusSyncReply where
    fromEnum :: BusSyncReply -> Int
fromEnum BusSyncReplyDrop = 0
    fromEnum BusSyncReplyPass = 1
    fromEnum BusSyncReplyAsync = 2
    fromEnum (AnotherBusSyncReply k :: Int
k) = Int
k

    toEnum :: Int -> BusSyncReply
toEnum 0 = BusSyncReply
BusSyncReplyDrop
    toEnum 1 = BusSyncReply
BusSyncReplyPass
    toEnum 2 = BusSyncReply
BusSyncReplyAsync
    toEnum k :: Int
k = Int -> BusSyncReply
AnotherBusSyncReply Int
k

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

foreign import ccall "gst_bus_sync_reply_get_type" c_gst_bus_sync_reply_get_type :: 
    IO GType

instance BoxedEnum BusSyncReply where
    boxedEnumType :: BusSyncReply -> IO GType
boxedEnumType _ = IO GType
c_gst_bus_sync_reply_get_type

-- Enum BufferingMode
-- | The different types of buffering methods.
data BufferingMode = 
      BufferingModeStream
    -- ^ a small amount of data is buffered
    | BufferingModeDownload
    -- ^ the stream is being downloaded
    | BufferingModeTimeshift
    -- ^ the stream is being downloaded in a ringbuffer
    | BufferingModeLive
    -- ^ the stream is a live stream
    | AnotherBufferingMode Int
    -- ^ Catch-all for unknown values
    deriving (Int -> BufferingMode -> ShowS
[BufferingMode] -> ShowS
BufferingMode -> String
(Int -> BufferingMode -> ShowS)
-> (BufferingMode -> String)
-> ([BufferingMode] -> ShowS)
-> Show BufferingMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BufferingMode] -> ShowS
$cshowList :: [BufferingMode] -> ShowS
show :: BufferingMode -> String
$cshow :: BufferingMode -> String
showsPrec :: Int -> BufferingMode -> ShowS
$cshowsPrec :: Int -> BufferingMode -> ShowS
Show, BufferingMode -> BufferingMode -> Bool
(BufferingMode -> BufferingMode -> Bool)
-> (BufferingMode -> BufferingMode -> Bool) -> Eq BufferingMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BufferingMode -> BufferingMode -> Bool
$c/= :: BufferingMode -> BufferingMode -> Bool
== :: BufferingMode -> BufferingMode -> Bool
$c== :: BufferingMode -> BufferingMode -> Bool
Eq)

instance P.Enum BufferingMode where
    fromEnum :: BufferingMode -> Int
fromEnum BufferingModeStream = 0
    fromEnum BufferingModeDownload = 1
    fromEnum BufferingModeTimeshift = 2
    fromEnum BufferingModeLive = 3
    fromEnum (AnotherBufferingMode k :: Int
k) = Int
k

    toEnum :: Int -> BufferingMode
toEnum 0 = BufferingMode
BufferingModeStream
    toEnum 1 = BufferingMode
BufferingModeDownload
    toEnum 2 = BufferingMode
BufferingModeTimeshift
    toEnum 3 = BufferingMode
BufferingModeLive
    toEnum k :: Int
k = Int -> BufferingMode
AnotherBufferingMode Int
k

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

foreign import ccall "gst_buffering_mode_get_type" c_gst_buffering_mode_get_type :: 
    IO GType

instance BoxedEnum BufferingMode where
    boxedEnumType :: BufferingMode -> IO GType
boxedEnumType _ = IO GType
c_gst_buffering_mode_get_type