{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A t'GI.Gst.Structs.Structure.Structure' is a collection of key\/value pairs. The keys are expressed as
-- GQuarks and the values can be of any GType.
-- 
-- In addition to the key\/value pairs, a t'GI.Gst.Structs.Structure.Structure' also has a name. The name
-- starts with a letter and can be filled by letters, numbers and any of
-- \"\/-_.:\".
-- 
-- t'GI.Gst.Structs.Structure.Structure' is used by various GStreamer subsystems to store information in
-- a flexible and extensible way. A t'GI.Gst.Structs.Structure.Structure' does not have a refcount
-- because it usually is part of a higher level object such as t'GI.Gst.Structs.Caps.Caps',
-- t'GI.Gst.Structs.Message.Message', t'GI.Gst.Structs.Event.Event', t'GI.Gst.Structs.Query.Query'. It provides a means to enforce mutability
-- using the refcount of the parent with the 'GI.Gst.Structs.Structure.structureSetParentRefcount'
-- method.
-- 
-- A t'GI.Gst.Structs.Structure.Structure' can be created with 'GI.Gst.Structs.Structure.structureNewEmpty' or
-- @/gst_structure_new()/@, which both take a name and an optional set of key\/value
-- pairs along with the types of the values.
-- 
-- Field values can be changed with 'GI.Gst.Structs.Structure.structureSetValue' or
-- @/gst_structure_set()/@.
-- 
-- Field values can be retrieved with 'GI.Gst.Structs.Structure.structureGetValue' or the more
-- convenient gst_structure_get_*() functions.
-- 
-- Fields can be removed with 'GI.Gst.Structs.Structure.structureRemoveField' or
-- @/gst_structure_remove_fields()/@.
-- 
-- Strings in structures must be ASCII or UTF-8 encoded. Other encodings are not
-- allowed. Strings may be 'P.Nothing' however.
-- 
-- == The serialization format
-- 
-- GstStructure serialization format serialize the GstStructure name,
-- keys\/GType\/values in a comma separated list with the structure name as first
-- field without value followed by separated key\/value pairs in the form
-- @key=value@, for example:
-- 
-- \`\`@
-- a-structure, key=value
-- @\`\`@
-- 
-- The values type will be inferred if not explicitly specified with the
-- @(GTypeName)value@ syntax, for example the following struct will have one
-- field called \'is-string\' which has the string \'true\' as a value:
-- 
-- @\`@
-- a-struct, field-is-string=(string)true, field-is-boolean=true
-- @\`@
-- 
-- *Note*: without specifying @(string), @field-is-string@ type would have been
-- inferred as boolean.
-- 
-- *Note*: we specified @(string)@ as a type even if @gchararray@ is the actual
-- GType name as for convenience some well known types have been aliased or
-- abbreviated.
-- 
-- To avoid specifying the type, you can give some hints to the \"type system\".
-- For example to specify a value as a double, you should add a decimal (ie. @1@
-- is an @int@ while @1.0@ is a @double@).
-- 
-- *Note*: when a structure is serialized with @/gst_structure_to_string/@, all
-- values are explicitly typed.
-- 
-- Some types have special delimiters:
-- 
-- * <http://developer.gnome.org/gst/stable/GST_TYPE_ARRAY GstValueArray> are inside curly brackets (@{@ and @}@).
-- For example @a-structure, array={1, 2, 3}@
-- * Ranges are inside brackets (@[@ and @]@). For example \`a-structure,
-- range=[1, 6, 2]\` 1 being the min value, 6 the maximum and 2 the step. To
-- specify a @/GST_TYPE_INT64_RANGE/@ you need to explicitly specify it like:
-- @a-structure, a-int64-range=(gint64) [1, 5]@
-- * <http://developer.gnome.org/gst/stable/GST_TYPE_LIST GstValueList> are inside \"less and greater than\" (@\<@ and
-- @>@). For example \`a-structure, list=\<1, 2, 3>
-- 
-- 
-- Structures are delimited either by a null character @\\0@ or a semicolumn @;@
-- the latter allowing to store multiple structures in the same string (see
-- t'GI.Gst.Structs.Caps.Caps').
-- 
-- Quotes are used as \"default\" delimiters and can be used around any types that
-- don\'t use other delimiters (for example @a-struct, i=(int)\"1\"@). They are use
-- to allow adding spaces or special characters (such as delimiters,
-- semicolumns, etc..) inside strings and you can use backslashes @\\@ to escape
-- characters inside them, for example:
-- 
-- \`\`@
-- a-struct, special=\"\\\"{[(;)]}\\\" can be used inside quotes\"
-- @\`@
-- 
-- They also allow for nested structure, such as:
-- 
-- @\`@
-- a-struct, nested=(GstStructure)\"nested-struct, nested=true\"
-- @\`\`
-- 
-- > *Note*: Be aware that the current t'GI.Gst.Structs.Caps.Caps' \/ t'GI.Gst.Structs.Structure.Structure' serialization
-- > into string has limited support for nested t'GI.Gst.Structs.Caps.Caps' \/ t'GI.Gst.Structs.Structure.Structure' fields.
-- > It can only support one level of nesting. Using more levels will lead to
-- > unexpected behavior when using serialization features, such as
-- > 'GI.Gst.Structs.Caps.capsToString' or 'GI.Gst.Functions.valueSerialize' and their counterparts.

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

module GI.Gst.Structs.Structure
    ( 

-- * Exported types
    Structure(..)                           ,
    newZeroStructure                        ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [canIntersect]("GI.Gst.Structs.Structure#g:method:canIntersect"), [copy]("GI.Gst.Structs.Structure#g:method:copy"), [filterAndMapInPlace]("GI.Gst.Structs.Structure#g:method:filterAndMapInPlace"), [fixate]("GI.Gst.Structs.Structure#g:method:fixate"), [fixateField]("GI.Gst.Structs.Structure#g:method:fixateField"), [fixateFieldBoolean]("GI.Gst.Structs.Structure#g:method:fixateFieldBoolean"), [fixateFieldNearestDouble]("GI.Gst.Structs.Structure#g:method:fixateFieldNearestDouble"), [fixateFieldNearestFraction]("GI.Gst.Structs.Structure#g:method:fixateFieldNearestFraction"), [fixateFieldNearestInt]("GI.Gst.Structs.Structure#g:method:fixateFieldNearestInt"), [fixateFieldString]("GI.Gst.Structs.Structure#g:method:fixateFieldString"), [foreach]("GI.Gst.Structs.Structure#g:method:foreach"), [free]("GI.Gst.Structs.Structure#g:method:free"), [hasField]("GI.Gst.Structs.Structure#g:method:hasField"), [hasFieldTyped]("GI.Gst.Structs.Structure#g:method:hasFieldTyped"), [hasName]("GI.Gst.Structs.Structure#g:method:hasName"), [idGetValue]("GI.Gst.Structs.Structure#g:method:idGetValue"), [idHasField]("GI.Gst.Structs.Structure#g:method:idHasField"), [idHasFieldTyped]("GI.Gst.Structs.Structure#g:method:idHasFieldTyped"), [idSetValue]("GI.Gst.Structs.Structure#g:method:idSetValue"), [idTakeValue]("GI.Gst.Structs.Structure#g:method:idTakeValue"), [intersect]("GI.Gst.Structs.Structure#g:method:intersect"), [isEqual]("GI.Gst.Structs.Structure#g:method:isEqual"), [isSubset]("GI.Gst.Structs.Structure#g:method:isSubset"), [mapInPlace]("GI.Gst.Structs.Structure#g:method:mapInPlace"), [nFields]("GI.Gst.Structs.Structure#g:method:nFields"), [nthFieldName]("GI.Gst.Structs.Structure#g:method:nthFieldName"), [removeAllFields]("GI.Gst.Structs.Structure#g:method:removeAllFields"), [removeField]("GI.Gst.Structs.Structure#g:method:removeField"), [takeValue]("GI.Gst.Structs.Structure#g:method:takeValue"), [toString]("GI.Gst.Structs.Structure#g:method:toString").
-- 
-- ==== Getters
-- [getArray]("GI.Gst.Structs.Structure#g:method:getArray"), [getBoolean]("GI.Gst.Structs.Structure#g:method:getBoolean"), [getClockTime]("GI.Gst.Structs.Structure#g:method:getClockTime"), [getDate]("GI.Gst.Structs.Structure#g:method:getDate"), [getDateTime]("GI.Gst.Structs.Structure#g:method:getDateTime"), [getDouble]("GI.Gst.Structs.Structure#g:method:getDouble"), [getEnum]("GI.Gst.Structs.Structure#g:method:getEnum"), [getFieldType]("GI.Gst.Structs.Structure#g:method:getFieldType"), [getFlagset]("GI.Gst.Structs.Structure#g:method:getFlagset"), [getFraction]("GI.Gst.Structs.Structure#g:method:getFraction"), [getInt]("GI.Gst.Structs.Structure#g:method:getInt"), [getInt64]("GI.Gst.Structs.Structure#g:method:getInt64"), [getList]("GI.Gst.Structs.Structure#g:method:getList"), [getName]("GI.Gst.Structs.Structure#g:method:getName"), [getNameId]("GI.Gst.Structs.Structure#g:method:getNameId"), [getString]("GI.Gst.Structs.Structure#g:method:getString"), [getUint]("GI.Gst.Structs.Structure#g:method:getUint"), [getUint64]("GI.Gst.Structs.Structure#g:method:getUint64"), [getValue]("GI.Gst.Structs.Structure#g:method:getValue").
-- 
-- ==== Setters
-- [setArray]("GI.Gst.Structs.Structure#g:method:setArray"), [setList]("GI.Gst.Structs.Structure#g:method:setList"), [setName]("GI.Gst.Structs.Structure#g:method:setName"), [setParentRefcount]("GI.Gst.Structs.Structure#g:method:setParentRefcount"), [setValue]("GI.Gst.Structs.Structure#g:method:setValue").

#if defined(ENABLE_OVERLOADING)
    ResolveStructureMethod                  ,
#endif

-- ** canIntersect #method:canIntersect#

#if defined(ENABLE_OVERLOADING)
    StructureCanIntersectMethodInfo         ,
#endif
    structureCanIntersect                   ,


-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    StructureCopyMethodInfo                 ,
#endif
    structureCopy                           ,


-- ** filterAndMapInPlace #method:filterAndMapInPlace#

#if defined(ENABLE_OVERLOADING)
    StructureFilterAndMapInPlaceMethodInfo  ,
#endif
    structureFilterAndMapInPlace            ,


-- ** fixate #method:fixate#

#if defined(ENABLE_OVERLOADING)
    StructureFixateMethodInfo               ,
#endif
    structureFixate                         ,


-- ** fixateField #method:fixateField#

#if defined(ENABLE_OVERLOADING)
    StructureFixateFieldMethodInfo          ,
#endif
    structureFixateField                    ,


-- ** fixateFieldBoolean #method:fixateFieldBoolean#

#if defined(ENABLE_OVERLOADING)
    StructureFixateFieldBooleanMethodInfo   ,
#endif
    structureFixateFieldBoolean             ,


-- ** fixateFieldNearestDouble #method:fixateFieldNearestDouble#

#if defined(ENABLE_OVERLOADING)
    StructureFixateFieldNearestDoubleMethodInfo,
#endif
    structureFixateFieldNearestDouble       ,


-- ** fixateFieldNearestFraction #method:fixateFieldNearestFraction#

#if defined(ENABLE_OVERLOADING)
    StructureFixateFieldNearestFractionMethodInfo,
#endif
    structureFixateFieldNearestFraction     ,


-- ** fixateFieldNearestInt #method:fixateFieldNearestInt#

#if defined(ENABLE_OVERLOADING)
    StructureFixateFieldNearestIntMethodInfo,
#endif
    structureFixateFieldNearestInt          ,


-- ** fixateFieldString #method:fixateFieldString#

#if defined(ENABLE_OVERLOADING)
    StructureFixateFieldStringMethodInfo    ,
#endif
    structureFixateFieldString              ,


-- ** foreach #method:foreach#

#if defined(ENABLE_OVERLOADING)
    StructureForeachMethodInfo              ,
#endif
    structureForeach                        ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    StructureFreeMethodInfo                 ,
#endif
    structureFree                           ,


-- ** fromString #method:fromString#

    structureFromString                     ,


-- ** getArray #method:getArray#

#if defined(ENABLE_OVERLOADING)
    StructureGetArrayMethodInfo             ,
#endif
    structureGetArray                       ,


-- ** getBoolean #method:getBoolean#

#if defined(ENABLE_OVERLOADING)
    StructureGetBooleanMethodInfo           ,
#endif
    structureGetBoolean                     ,


-- ** getClockTime #method:getClockTime#

#if defined(ENABLE_OVERLOADING)
    StructureGetClockTimeMethodInfo         ,
#endif
    structureGetClockTime                   ,


-- ** getDate #method:getDate#

#if defined(ENABLE_OVERLOADING)
    StructureGetDateMethodInfo              ,
#endif
    structureGetDate                        ,


-- ** getDateTime #method:getDateTime#

#if defined(ENABLE_OVERLOADING)
    StructureGetDateTimeMethodInfo          ,
#endif
    structureGetDateTime                    ,


-- ** getDouble #method:getDouble#

#if defined(ENABLE_OVERLOADING)
    StructureGetDoubleMethodInfo            ,
#endif
    structureGetDouble                      ,


-- ** getEnum #method:getEnum#

#if defined(ENABLE_OVERLOADING)
    StructureGetEnumMethodInfo              ,
#endif
    structureGetEnum                        ,


-- ** getFieldType #method:getFieldType#

#if defined(ENABLE_OVERLOADING)
    StructureGetFieldTypeMethodInfo         ,
#endif
    structureGetFieldType                   ,


-- ** getFlagset #method:getFlagset#

#if defined(ENABLE_OVERLOADING)
    StructureGetFlagsetMethodInfo           ,
#endif
    structureGetFlagset                     ,


-- ** getFraction #method:getFraction#

#if defined(ENABLE_OVERLOADING)
    StructureGetFractionMethodInfo          ,
#endif
    structureGetFraction                    ,


-- ** getInt #method:getInt#

#if defined(ENABLE_OVERLOADING)
    StructureGetIntMethodInfo               ,
#endif
    structureGetInt                         ,


-- ** getInt64 #method:getInt64#

#if defined(ENABLE_OVERLOADING)
    StructureGetInt64MethodInfo             ,
#endif
    structureGetInt64                       ,


-- ** getList #method:getList#

#if defined(ENABLE_OVERLOADING)
    StructureGetListMethodInfo              ,
#endif
    structureGetList                        ,


-- ** getName #method:getName#

#if defined(ENABLE_OVERLOADING)
    StructureGetNameMethodInfo              ,
#endif
    structureGetName                        ,


-- ** getNameId #method:getNameId#

#if defined(ENABLE_OVERLOADING)
    StructureGetNameIdMethodInfo            ,
#endif
    structureGetNameId                      ,


-- ** getString #method:getString#

#if defined(ENABLE_OVERLOADING)
    StructureGetStringMethodInfo            ,
#endif
    structureGetString                      ,


-- ** getUint #method:getUint#

#if defined(ENABLE_OVERLOADING)
    StructureGetUintMethodInfo              ,
#endif
    structureGetUint                        ,


-- ** getUint64 #method:getUint64#

#if defined(ENABLE_OVERLOADING)
    StructureGetUint64MethodInfo            ,
#endif
    structureGetUint64                      ,


-- ** getValue #method:getValue#

#if defined(ENABLE_OVERLOADING)
    StructureGetValueMethodInfo             ,
#endif
    structureGetValue                       ,


-- ** hasField #method:hasField#

#if defined(ENABLE_OVERLOADING)
    StructureHasFieldMethodInfo             ,
#endif
    structureHasField                       ,


-- ** hasFieldTyped #method:hasFieldTyped#

#if defined(ENABLE_OVERLOADING)
    StructureHasFieldTypedMethodInfo        ,
#endif
    structureHasFieldTyped                  ,


-- ** hasName #method:hasName#

#if defined(ENABLE_OVERLOADING)
    StructureHasNameMethodInfo              ,
#endif
    structureHasName                        ,


-- ** idGetValue #method:idGetValue#

#if defined(ENABLE_OVERLOADING)
    StructureIdGetValueMethodInfo           ,
#endif
    structureIdGetValue                     ,


-- ** idHasField #method:idHasField#

#if defined(ENABLE_OVERLOADING)
    StructureIdHasFieldMethodInfo           ,
#endif
    structureIdHasField                     ,


-- ** idHasFieldTyped #method:idHasFieldTyped#

#if defined(ENABLE_OVERLOADING)
    StructureIdHasFieldTypedMethodInfo      ,
#endif
    structureIdHasFieldTyped                ,


-- ** idSetValue #method:idSetValue#

#if defined(ENABLE_OVERLOADING)
    StructureIdSetValueMethodInfo           ,
#endif
    structureIdSetValue                     ,


-- ** idTakeValue #method:idTakeValue#

#if defined(ENABLE_OVERLOADING)
    StructureIdTakeValueMethodInfo          ,
#endif
    structureIdTakeValue                    ,


-- ** intersect #method:intersect#

#if defined(ENABLE_OVERLOADING)
    StructureIntersectMethodInfo            ,
#endif
    structureIntersect                      ,


-- ** isEqual #method:isEqual#

#if defined(ENABLE_OVERLOADING)
    StructureIsEqualMethodInfo              ,
#endif
    structureIsEqual                        ,


-- ** isSubset #method:isSubset#

#if defined(ENABLE_OVERLOADING)
    StructureIsSubsetMethodInfo             ,
#endif
    structureIsSubset                       ,


-- ** mapInPlace #method:mapInPlace#

#if defined(ENABLE_OVERLOADING)
    StructureMapInPlaceMethodInfo           ,
#endif
    structureMapInPlace                     ,


-- ** nFields #method:nFields#

#if defined(ENABLE_OVERLOADING)
    StructureNFieldsMethodInfo              ,
#endif
    structureNFields                        ,


-- ** newEmpty #method:newEmpty#

    structureNewEmpty                       ,


-- ** newFromString #method:newFromString#

    structureNewFromString                  ,


-- ** newIdEmpty #method:newIdEmpty#

    structureNewIdEmpty                     ,


-- ** nthFieldName #method:nthFieldName#

#if defined(ENABLE_OVERLOADING)
    StructureNthFieldNameMethodInfo         ,
#endif
    structureNthFieldName                   ,


-- ** removeAllFields #method:removeAllFields#

#if defined(ENABLE_OVERLOADING)
    StructureRemoveAllFieldsMethodInfo      ,
#endif
    structureRemoveAllFields                ,


-- ** removeField #method:removeField#

#if defined(ENABLE_OVERLOADING)
    StructureRemoveFieldMethodInfo          ,
#endif
    structureRemoveField                    ,


-- ** setArray #method:setArray#

#if defined(ENABLE_OVERLOADING)
    StructureSetArrayMethodInfo             ,
#endif
    structureSetArray                       ,


-- ** setList #method:setList#

#if defined(ENABLE_OVERLOADING)
    StructureSetListMethodInfo              ,
#endif
    structureSetList                        ,


-- ** setName #method:setName#

#if defined(ENABLE_OVERLOADING)
    StructureSetNameMethodInfo              ,
#endif
    structureSetName                        ,


-- ** setParentRefcount #method:setParentRefcount#

#if defined(ENABLE_OVERLOADING)
    StructureSetParentRefcountMethodInfo    ,
#endif
    structureSetParentRefcount              ,


-- ** setValue #method:setValue#

#if defined(ENABLE_OVERLOADING)
    StructureSetValueMethodInfo             ,
#endif
    structureSetValue                       ,


-- ** takeValue #method:takeValue#

#if defined(ENABLE_OVERLOADING)
    StructureTakeValueMethodInfo            ,
#endif
    structureTakeValue                      ,


-- ** toString #method:toString#

#if defined(ENABLE_OVERLOADING)
    StructureToStringMethodInfo             ,
#endif
    structureToString                       ,




 -- * Properties


-- ** type #attr:type#
-- | the GType of a structure

    getStructureType                        ,
    setStructureType                        ,
#if defined(ENABLE_OVERLOADING)
    structure_type                          ,
#endif




    ) 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.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
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 Control.Monad.IO.Class as MIO
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
import qualified GHC.Records as R

import qualified GI.GLib.Structs.Date as GLib.Date
import qualified GI.GObject.Structs.ValueArray as GObject.ValueArray
import qualified GI.Gst.Callbacks as Gst.Callbacks
import {-# SOURCE #-} qualified GI.Gst.Structs.DateTime as Gst.DateTime

-- | Memory-managed wrapper type.
newtype Structure = Structure (SP.ManagedPtr Structure)
    deriving (Structure -> Structure -> Bool
(Structure -> Structure -> Bool)
-> (Structure -> Structure -> Bool) -> Eq Structure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Structure -> Structure -> Bool
$c/= :: Structure -> Structure -> Bool
== :: Structure -> Structure -> Bool
$c== :: Structure -> Structure -> Bool
Eq)

instance SP.ManagedPtrNewtype Structure where
    toManagedPtr :: Structure -> ManagedPtr Structure
toManagedPtr (Structure ManagedPtr Structure
p) = ManagedPtr Structure
p

foreign import ccall "gst_structure_get_type" c_gst_structure_get_type :: 
    IO GType

type instance O.ParentTypes Structure = '[]
instance O.HasParentTypes Structure

instance B.Types.TypedObject Structure where
    glibType :: IO GType
glibType = IO GType
c_gst_structure_get_type

instance B.Types.GBoxed Structure

-- | Convert 'Structure' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe Structure) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gst_structure_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Structure -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Structure
P.Nothing = Ptr GValue -> Ptr Structure -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv (Ptr Structure
forall a. Ptr a
FP.nullPtr :: FP.Ptr Structure)
    gvalueSet_ Ptr GValue
gv (P.Just Structure
obj) = Structure -> (Ptr Structure -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Structure
obj (Ptr GValue -> Ptr Structure -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Structure)
gvalueGet_ Ptr GValue
gv = do
        Ptr Structure
ptr <- Ptr GValue -> IO (Ptr Structure)
forall b. Ptr GValue -> IO (Ptr b)
B.GValue.get_boxed Ptr GValue
gv :: IO (Ptr Structure)
        if Ptr Structure
ptr Ptr Structure -> Ptr Structure -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Structure
forall a. Ptr a
FP.nullPtr
        then Structure -> Maybe Structure
forall a. a -> Maybe a
P.Just (Structure -> Maybe Structure)
-> IO Structure -> IO (Maybe Structure)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr Structure -> Structure)
-> Ptr Structure -> IO Structure
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr Structure -> Structure
Structure Ptr Structure
ptr
        else Maybe Structure -> IO (Maybe Structure)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Structure
forall a. Maybe a
P.Nothing
        
    

-- | Construct a `Structure` struct initialized to zero.
newZeroStructure :: MonadIO m => m Structure
newZeroStructure :: forall (m :: * -> *). MonadIO m => m Structure
newZeroStructure = IO Structure -> m Structure
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Structure -> m Structure) -> IO Structure -> m Structure
forall a b. (a -> b) -> a -> b
$ Int -> IO (Ptr Structure)
forall a. GBoxed a => Int -> IO (Ptr a)
callocBoxedBytes Int
16 IO (Ptr Structure)
-> (Ptr Structure -> IO Structure) -> IO Structure
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr Structure -> Structure)
-> Ptr Structure -> IO Structure
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Structure -> Structure
Structure

instance tag ~ 'AttrSet => Constructible Structure tag where
    new :: forall (m :: * -> *).
MonadIO m =>
(ManagedPtr Structure -> Structure)
-> [AttrOp Structure tag] -> m Structure
new ManagedPtr Structure -> Structure
_ [AttrOp Structure tag]
attrs = do
        Structure
o <- m Structure
forall (m :: * -> *). MonadIO m => m Structure
newZeroStructure
        Structure -> [AttrOp Structure 'AttrSet] -> m ()
forall o (m :: * -> *).
MonadIO m =>
o -> [AttrOp o 'AttrSet] -> m ()
GI.Attributes.set Structure
o [AttrOp Structure tag]
[AttrOp Structure 'AttrSet]
attrs
        Structure -> m Structure
forall (m :: * -> *) a. Monad m => a -> m a
return Structure
o


-- | Get the value of the “@type@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' structure #type
-- @
getStructureType :: MonadIO m => Structure -> m GType
getStructureType :: forall (m :: * -> *). MonadIO m => Structure -> m GType
getStructureType Structure
s = IO GType -> m GType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GType -> m GType) -> IO GType -> m GType
forall a b. (a -> b) -> a -> b
$ Structure -> (Ptr Structure -> IO GType) -> IO GType
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Structure
s ((Ptr Structure -> IO GType) -> IO GType)
-> (Ptr Structure -> IO GType) -> IO GType
forall a b. (a -> b) -> a -> b
$ \Ptr Structure
ptr -> do
    CGType
val <- Ptr CGType -> IO CGType
forall a. Storable a => Ptr a -> IO a
peek (Ptr Structure
ptr Ptr Structure -> Int -> Ptr CGType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) :: IO CGType
    let val' :: GType
val' = CGType -> GType
GType CGType
val
    GType -> IO GType
forall (m :: * -> *) a. Monad m => a -> m a
return GType
val'

-- | Set the value of the “@type@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' structure [ #type 'Data.GI.Base.Attributes.:=' value ]
-- @
setStructureType :: MonadIO m => Structure -> GType -> m ()
setStructureType :: forall (m :: * -> *). MonadIO m => Structure -> GType -> m ()
setStructureType Structure
s GType
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Structure -> (Ptr Structure -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Structure
s ((Ptr Structure -> IO ()) -> IO ())
-> (Ptr Structure -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Structure
ptr -> do
    let val' :: CGType
val' = GType -> CGType
gtypeToCGType GType
val
    Ptr CGType -> CGType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Structure
ptr Ptr Structure -> Int -> Ptr CGType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (CGType
val' :: CGType)

#if defined(ENABLE_OVERLOADING)
data StructureTypeFieldInfo
instance AttrInfo StructureTypeFieldInfo where
    type AttrBaseTypeConstraint StructureTypeFieldInfo = (~) Structure
    type AttrAllowedOps StructureTypeFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint StructureTypeFieldInfo = (~) GType
    type AttrTransferTypeConstraint StructureTypeFieldInfo = (~)GType
    type AttrTransferType StructureTypeFieldInfo = GType
    type AttrGetType StructureTypeFieldInfo = GType
    type AttrLabel StructureTypeFieldInfo = "type"
    type AttrOrigin StructureTypeFieldInfo = Structure
    attrGet = getStructureType
    attrSet = setStructureType
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

structure_type :: AttrLabelProxy "type"
structure_type = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Structure
type instance O.AttributeList Structure = StructureAttributeList
type StructureAttributeList = ('[ '("type", StructureTypeFieldInfo)] :: [(Symbol, *)])
#endif

-- method Structure::from_string
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "string"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a string representation of a #GstStructure."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "end"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "pointer to store the end of the string in."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Structure" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_from_string" gst_structure_from_string :: 
    CString ->                              -- string : TBasicType TUTF8
    Ptr CString ->                          -- end : TBasicType TUTF8
    IO (Ptr Structure)

-- | Creates a t'GI.Gst.Structs.Structure.Structure' from a string representation.
-- If end is not 'P.Nothing', a pointer to the place inside the given string
-- where parsing ended will be returned.
-- 
-- Free-function: gst_structure_free
structureFromString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@string@/: a string representation of a t'GI.Gst.Structs.Structure.Structure'.
    -> m ((Maybe Structure, T.Text))
    -- ^ __Returns:__ a new t'GI.Gst.Structs.Structure.Structure' or 'P.Nothing'
    --     when the string could not be parsed. Free with
    --     'GI.Gst.Structs.Structure.structureFree' after use.
structureFromString :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> m (Maybe Structure, Text)
structureFromString Text
string = IO (Maybe Structure, Text) -> m (Maybe Structure, Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Structure, Text) -> m (Maybe Structure, Text))
-> IO (Maybe Structure, Text) -> m (Maybe Structure, Text)
forall a b. (a -> b) -> a -> b
$ do
    CString
string' <- Text -> IO CString
textToCString Text
string
    Ptr CString
end <- IO (Ptr CString)
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr CString)
    Ptr Structure
result <- CString -> Ptr CString -> IO (Ptr Structure)
gst_structure_from_string CString
string' Ptr CString
end
    Maybe Structure
maybeResult <- Ptr Structure
-> (Ptr Structure -> IO Structure) -> IO (Maybe Structure)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Structure
result ((Ptr Structure -> IO Structure) -> IO (Maybe Structure))
-> (Ptr Structure -> IO Structure) -> IO (Maybe Structure)
forall a b. (a -> b) -> a -> b
$ \Ptr Structure
result' -> do
        Structure
result'' <- ((ManagedPtr Structure -> Structure)
-> Ptr Structure -> IO Structure
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Structure -> Structure
Structure) Ptr Structure
result'
        Structure -> IO Structure
forall (m :: * -> *) a. Monad m => a -> m a
return Structure
result''
    CString
end' <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
end
    Text
end'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
end'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
string'
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
end
    (Maybe Structure, Text) -> IO (Maybe Structure, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Structure
maybeResult, Text
end'')

#if defined(ENABLE_OVERLOADING)
#endif

-- method Structure::new_empty
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "name of new structure"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Structure" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_new_empty" gst_structure_new_empty :: 
    CString ->                              -- name : TBasicType TUTF8
    IO (Ptr Structure)

-- | Creates a new, empty t'GI.Gst.Structs.Structure.Structure' with the given /@name@/.
-- 
-- See 'GI.Gst.Structs.Structure.structureSetName' for constraints on the /@name@/ parameter.
-- 
-- Free-function: gst_structure_free
structureNewEmpty ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@name@/: name of new structure
    -> m Structure
    -- ^ __Returns:__ a new, empty t'GI.Gst.Structs.Structure.Structure'
structureNewEmpty :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> m Structure
structureNewEmpty Text
name = IO Structure -> m Structure
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Structure -> m Structure) -> IO Structure -> m Structure
forall a b. (a -> b) -> a -> b
$ do
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr Structure
result <- CString -> IO (Ptr Structure)
gst_structure_new_empty CString
name'
    Text -> Ptr Structure -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"structureNewEmpty" Ptr Structure
result
    Structure
result' <- ((ManagedPtr Structure -> Structure)
-> Ptr Structure -> IO Structure
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Structure -> Structure
Structure) Ptr Structure
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Structure -> IO Structure
forall (m :: * -> *) a. Monad m => a -> m a
return Structure
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Structure::new_from_string
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "string"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a string representation of a #GstStructure"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Structure" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_new_from_string" gst_structure_new_from_string :: 
    CString ->                              -- string : TBasicType TUTF8
    IO (Ptr Structure)

-- | Creates a t'GI.Gst.Structs.Structure.Structure' from a string representation.
-- If end is not 'P.Nothing', a pointer to the place inside the given string
-- where parsing ended will be returned.
-- 
-- The current implementation of serialization will lead to unexpected results
-- when there are nested t'GI.Gst.Structs.Caps.Caps' \/ t'GI.Gst.Structs.Structure.Structure' deeper than one level.
-- 
-- Free-function: gst_structure_free
-- 
-- /Since: 1.2/
structureNewFromString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@string@/: a string representation of a t'GI.Gst.Structs.Structure.Structure'
    -> m (Maybe Structure)
    -- ^ __Returns:__ a new t'GI.Gst.Structs.Structure.Structure' or 'P.Nothing'
    --     when the string could not be parsed. Free with
    --     'GI.Gst.Structs.Structure.structureFree' after use.
structureNewFromString :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> m (Maybe Structure)
structureNewFromString Text
string = IO (Maybe Structure) -> m (Maybe Structure)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Structure) -> m (Maybe Structure))
-> IO (Maybe Structure) -> m (Maybe Structure)
forall a b. (a -> b) -> a -> b
$ do
    CString
string' <- Text -> IO CString
textToCString Text
string
    Ptr Structure
result <- CString -> IO (Ptr Structure)
gst_structure_new_from_string CString
string'
    Maybe Structure
maybeResult <- Ptr Structure
-> (Ptr Structure -> IO Structure) -> IO (Maybe Structure)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Structure
result ((Ptr Structure -> IO Structure) -> IO (Maybe Structure))
-> (Ptr Structure -> IO Structure) -> IO (Maybe Structure)
forall a b. (a -> b) -> a -> b
$ \Ptr Structure
result' -> do
        Structure
result'' <- ((ManagedPtr Structure -> Structure)
-> Ptr Structure -> IO Structure
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Structure -> Structure
Structure) Ptr Structure
result'
        Structure -> IO Structure
forall (m :: * -> *) a. Monad m => a -> m a
return Structure
result''
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
string'
    Maybe Structure -> IO (Maybe Structure)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Structure
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

-- method Structure::new_id_empty
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "quark"
--           , argType = TBasicType TUInt32
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "name of new structure"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Structure" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_new_id_empty" gst_structure_new_id_empty :: 
    Word32 ->                               -- quark : TBasicType TUInt32
    IO (Ptr Structure)

-- | Creates a new, empty t'GI.Gst.Structs.Structure.Structure' with the given name as a GQuark.
-- 
-- Free-function: gst_structure_free
structureNewIdEmpty ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Word32
    -- ^ /@quark@/: name of new structure
    -> m Structure
    -- ^ __Returns:__ a new, empty t'GI.Gst.Structs.Structure.Structure'
structureNewIdEmpty :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Word32 -> m Structure
structureNewIdEmpty Word32
quark = IO Structure -> m Structure
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Structure -> m Structure) -> IO Structure -> m Structure
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
result <- Word32 -> IO (Ptr Structure)
gst_structure_new_id_empty Word32
quark
    Text -> Ptr Structure -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"structureNewIdEmpty" Ptr Structure
result
    Structure
result' <- ((ManagedPtr Structure -> Structure)
-> Ptr Structure -> IO Structure
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Structure -> Structure
Structure) Ptr Structure
result
    Structure -> IO Structure
forall (m :: * -> *) a. Monad m => a -> m a
return Structure
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Structure::can_intersect
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "struct1"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "struct2"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_can_intersect" gst_structure_can_intersect :: 
    Ptr Structure ->                        -- struct1 : TInterface (Name {namespace = "Gst", name = "Structure"})
    Ptr Structure ->                        -- struct2 : TInterface (Name {namespace = "Gst", name = "Structure"})
    IO CInt

-- | Tries intersecting /@struct1@/ and /@struct2@/ and reports whether the result
-- would not be empty.
structureCanIntersect ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Structure
    -- ^ /@struct1@/: a t'GI.Gst.Structs.Structure.Structure'
    -> Structure
    -- ^ /@struct2@/: a t'GI.Gst.Structs.Structure.Structure'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if intersection would not be empty
structureCanIntersect :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> Structure -> m Bool
structureCanIntersect Structure
struct1 Structure
struct2 = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
struct1' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
struct1
    Ptr Structure
struct2' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
struct2
    CInt
result <- Ptr Structure -> Ptr Structure -> IO CInt
gst_structure_can_intersect Ptr Structure
struct1' Ptr Structure
struct2'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
struct1
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
struct2
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data StructureCanIntersectMethodInfo
instance (signature ~ (Structure -> m Bool), MonadIO m) => O.OverloadedMethod StructureCanIntersectMethodInfo Structure signature where
    overloadedMethod = structureCanIntersect

instance O.OverloadedMethodInfo StructureCanIntersectMethodInfo Structure where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Structs.Structure.structureCanIntersect",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Structs-Structure.html#v:structureCanIntersect"
        }


#endif

-- method Structure::copy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure to duplicate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Structure" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_copy" gst_structure_copy :: 
    Ptr Structure ->                        -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    IO (Ptr Structure)

-- | Duplicates a t'GI.Gst.Structs.Structure.Structure' and all its fields and values.
-- 
-- Free-function: gst_structure_free
structureCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Structure
    -- ^ /@structure@/: a t'GI.Gst.Structs.Structure.Structure' to duplicate
    -> m Structure
    -- ^ __Returns:__ a new t'GI.Gst.Structs.Structure.Structure'.
structureCopy :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> m Structure
structureCopy Structure
structure = IO Structure -> m Structure
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Structure -> m Structure) -> IO Structure -> m Structure
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
structure
    Ptr Structure
result <- Ptr Structure -> IO (Ptr Structure)
gst_structure_copy Ptr Structure
structure'
    Text -> Ptr Structure -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"structureCopy" Ptr Structure
result
    Structure
result' <- ((ManagedPtr Structure -> Structure)
-> Ptr Structure -> IO Structure
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Structure -> Structure
Structure) Ptr Structure
result
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    Structure -> IO Structure
forall (m :: * -> *) a. Monad m => a -> m a
return Structure
result'

#if defined(ENABLE_OVERLOADING)
data StructureCopyMethodInfo
instance (signature ~ (m Structure), MonadIO m) => O.OverloadedMethod StructureCopyMethodInfo Structure signature where
    overloadedMethod = structureCopy

instance O.OverloadedMethodInfo StructureCopyMethodInfo Structure where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Structs.Structure.structureCopy",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Structs-Structure.html#v:structureCopy"
        }


#endif

-- method Structure::filter_and_map_in_place
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "func"
--           , argType =
--               TInterface
--                 Name { namespace = "Gst" , name = "StructureFilterMapFunc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a function to call for each field"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeCall
--           , argClosure = 2
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "private data" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_filter_and_map_in_place" gst_structure_filter_and_map_in_place :: 
    Ptr Structure ->                        -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    FunPtr Gst.Callbacks.C_StructureFilterMapFunc -> -- func : TInterface (Name {namespace = "Gst", name = "StructureFilterMapFunc"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Calls the provided function once for each field in the t'GI.Gst.Structs.Structure.Structure'. In
-- contrast to 'GI.Gst.Structs.Structure.structureForeach', the function may modify the fields.
-- In contrast to 'GI.Gst.Structs.Structure.structureMapInPlace', the field is removed from
-- the structure if 'P.False' is returned from the function.
-- The structure must be mutable.
-- 
-- /Since: 1.6/
structureFilterAndMapInPlace ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Structure
    -- ^ /@structure@/: a t'GI.Gst.Structs.Structure.Structure'
    -> Gst.Callbacks.StructureFilterMapFunc
    -- ^ /@func@/: a function to call for each field
    -> m ()
structureFilterAndMapInPlace :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> StructureFilterMapFunc -> m ()
structureFilterAndMapInPlace Structure
structure StructureFilterMapFunc
func = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
structure
    FunPtr C_StructureFilterMapFunc
func' <- C_StructureFilterMapFunc -> IO (FunPtr C_StructureFilterMapFunc)
Gst.Callbacks.mk_StructureFilterMapFunc (Maybe (Ptr (FunPtr C_StructureFilterMapFunc))
-> StructureFilterMapFunc_WithClosures -> C_StructureFilterMapFunc
Gst.Callbacks.wrap_StructureFilterMapFunc Maybe (Ptr (FunPtr C_StructureFilterMapFunc))
forall a. Maybe a
Nothing (StructureFilterMapFunc -> StructureFilterMapFunc_WithClosures
Gst.Callbacks.drop_closures_StructureFilterMapFunc StructureFilterMapFunc
func))
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Structure -> FunPtr C_StructureFilterMapFunc -> Ptr () -> IO ()
gst_structure_filter_and_map_in_place Ptr Structure
structure' FunPtr C_StructureFilterMapFunc
func' Ptr ()
forall a. Ptr a
userData
    Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_StructureFilterMapFunc -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_StructureFilterMapFunc
func'
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data StructureFilterAndMapInPlaceMethodInfo
instance (signature ~ (Gst.Callbacks.StructureFilterMapFunc -> m ()), MonadIO m) => O.OverloadedMethod StructureFilterAndMapInPlaceMethodInfo Structure signature where
    overloadedMethod = structureFilterAndMapInPlace

instance O.OverloadedMethodInfo StructureFilterAndMapInPlaceMethodInfo Structure where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Structs.Structure.structureFilterAndMapInPlace",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Structs-Structure.html#v:structureFilterAndMapInPlace"
        }


#endif

-- method Structure::fixate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_fixate" gst_structure_fixate :: 
    Ptr Structure ->                        -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    IO ()

-- | Fixate all values in /@structure@/ using 'GI.Gst.Functions.valueFixate'.
-- /@structure@/ will be modified in-place and should be writable.
structureFixate ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Structure
    -- ^ /@structure@/: a t'GI.Gst.Structs.Structure.Structure'
    -> m ()
structureFixate :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> m ()
structureFixate Structure
structure = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
structure
    Ptr Structure -> IO ()
gst_structure_fixate Ptr Structure
structure'
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data StructureFixateMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod StructureFixateMethodInfo Structure signature where
    overloadedMethod = structureFixate

instance O.OverloadedMethodInfo StructureFixateMethodInfo Structure where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Structs.Structure.structureFixate",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Structs-Structure.html#v:structureFixate"
        }


#endif

-- method Structure::fixate_field
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "field_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a field in @structure"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_fixate_field" gst_structure_fixate_field :: 
    Ptr Structure ->                        -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    CString ->                              -- field_name : TBasicType TUTF8
    IO CInt

-- | Fixates a t'GI.Gst.Structs.Structure.Structure' by changing the given field with its fixated value.
structureFixateField ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Structure
    -- ^ /@structure@/: a t'GI.Gst.Structs.Structure.Structure'
    -> T.Text
    -- ^ /@fieldName@/: a field in /@structure@/
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the structure field could be fixated
structureFixateField :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> Text -> m Bool
structureFixateField Structure
structure Text
fieldName = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
structure
    CString
fieldName' <- Text -> IO CString
textToCString Text
fieldName
    CInt
result <- Ptr Structure -> CString -> IO CInt
gst_structure_fixate_field Ptr Structure
structure' CString
fieldName'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
fieldName'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data StructureFixateFieldMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m) => O.OverloadedMethod StructureFixateFieldMethodInfo Structure signature where
    overloadedMethod = structureFixateField

instance O.OverloadedMethodInfo StructureFixateFieldMethodInfo Structure where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Structs.Structure.structureFixateField",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Structs-Structure.html#v:structureFixateField"
        }


#endif

-- method Structure::fixate_field_boolean
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "field_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a field in @structure"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "target"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the target value of the fixation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_fixate_field_boolean" gst_structure_fixate_field_boolean :: 
    Ptr Structure ->                        -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    CString ->                              -- field_name : TBasicType TUTF8
    CInt ->                                 -- target : TBasicType TBoolean
    IO CInt

-- | Fixates a t'GI.Gst.Structs.Structure.Structure' by changing the given /@fieldName@/ field to the given
-- /@target@/ boolean if that field is not fixed yet.
structureFixateFieldBoolean ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Structure
    -- ^ /@structure@/: a t'GI.Gst.Structs.Structure.Structure'
    -> T.Text
    -- ^ /@fieldName@/: a field in /@structure@/
    -> Bool
    -- ^ /@target@/: the target value of the fixation
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the structure could be fixated
structureFixateFieldBoolean :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> Text -> Bool -> m Bool
structureFixateFieldBoolean Structure
structure Text
fieldName Bool
target = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
structure
    CString
fieldName' <- Text -> IO CString
textToCString Text
fieldName
    let target' :: CInt
target' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
target
    CInt
result <- Ptr Structure -> CString -> CInt -> IO CInt
gst_structure_fixate_field_boolean Ptr Structure
structure' CString
fieldName' CInt
target'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
fieldName'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data StructureFixateFieldBooleanMethodInfo
instance (signature ~ (T.Text -> Bool -> m Bool), MonadIO m) => O.OverloadedMethod StructureFixateFieldBooleanMethodInfo Structure signature where
    overloadedMethod = structureFixateFieldBoolean

instance O.OverloadedMethodInfo StructureFixateFieldBooleanMethodInfo Structure where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Structs.Structure.structureFixateFieldBoolean",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Structs-Structure.html#v:structureFixateFieldBoolean"
        }


#endif

-- method Structure::fixate_field_nearest_double
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "field_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a field in @structure"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "target"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the target value of the fixation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_fixate_field_nearest_double" gst_structure_fixate_field_nearest_double :: 
    Ptr Structure ->                        -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    CString ->                              -- field_name : TBasicType TUTF8
    CDouble ->                              -- target : TBasicType TDouble
    IO CInt

-- | Fixates a t'GI.Gst.Structs.Structure.Structure' by changing the given field to the nearest
-- double to /@target@/ that is a subset of the existing field.
structureFixateFieldNearestDouble ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Structure
    -- ^ /@structure@/: a t'GI.Gst.Structs.Structure.Structure'
    -> T.Text
    -- ^ /@fieldName@/: a field in /@structure@/
    -> Double
    -- ^ /@target@/: the target value of the fixation
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the structure could be fixated
structureFixateFieldNearestDouble :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> Text -> Double -> m Bool
structureFixateFieldNearestDouble Structure
structure Text
fieldName Double
target = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
structure
    CString
fieldName' <- Text -> IO CString
textToCString Text
fieldName
    let target' :: CDouble
target' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
target
    CInt
result <- Ptr Structure -> CString -> CDouble -> IO CInt
gst_structure_fixate_field_nearest_double Ptr Structure
structure' CString
fieldName' CDouble
target'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
fieldName'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data StructureFixateFieldNearestDoubleMethodInfo
instance (signature ~ (T.Text -> Double -> m Bool), MonadIO m) => O.OverloadedMethod StructureFixateFieldNearestDoubleMethodInfo Structure signature where
    overloadedMethod = structureFixateFieldNearestDouble

instance O.OverloadedMethodInfo StructureFixateFieldNearestDoubleMethodInfo Structure where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Structs.Structure.structureFixateFieldNearestDouble",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Structs-Structure.html#v:structureFixateFieldNearestDouble"
        }


#endif

-- method Structure::fixate_field_nearest_fraction
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "field_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a field in @structure"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "target_numerator"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The numerator of the target value of the fixation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "target_denominator"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The denominator of the target value of the fixation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_fixate_field_nearest_fraction" gst_structure_fixate_field_nearest_fraction :: 
    Ptr Structure ->                        -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    CString ->                              -- field_name : TBasicType TUTF8
    Int32 ->                                -- target_numerator : TBasicType TInt
    Int32 ->                                -- target_denominator : TBasicType TInt
    IO CInt

-- | Fixates a t'GI.Gst.Structs.Structure.Structure' by changing the given field to the nearest
-- fraction to /@targetNumerator@/\//@targetDenominator@/ that is a subset
-- of the existing field.
structureFixateFieldNearestFraction ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Structure
    -- ^ /@structure@/: a t'GI.Gst.Structs.Structure.Structure'
    -> T.Text
    -- ^ /@fieldName@/: a field in /@structure@/
    -> Int32
    -- ^ /@targetNumerator@/: The numerator of the target value of the fixation
    -> Int32
    -- ^ /@targetDenominator@/: The denominator of the target value of the fixation
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the structure could be fixated
structureFixateFieldNearestFraction :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> Text -> Int32 -> Int32 -> m Bool
structureFixateFieldNearestFraction Structure
structure Text
fieldName Int32
targetNumerator Int32
targetDenominator = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
structure
    CString
fieldName' <- Text -> IO CString
textToCString Text
fieldName
    CInt
result <- Ptr Structure -> CString -> Int32 -> Int32 -> IO CInt
gst_structure_fixate_field_nearest_fraction Ptr Structure
structure' CString
fieldName' Int32
targetNumerator Int32
targetDenominator
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
fieldName'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data StructureFixateFieldNearestFractionMethodInfo
instance (signature ~ (T.Text -> Int32 -> Int32 -> m Bool), MonadIO m) => O.OverloadedMethod StructureFixateFieldNearestFractionMethodInfo Structure signature where
    overloadedMethod = structureFixateFieldNearestFraction

instance O.OverloadedMethodInfo StructureFixateFieldNearestFractionMethodInfo Structure where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Structs.Structure.structureFixateFieldNearestFraction",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Structs-Structure.html#v:structureFixateFieldNearestFraction"
        }


#endif

-- method Structure::fixate_field_nearest_int
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "field_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a field in @structure"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "target"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the target value of the fixation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_fixate_field_nearest_int" gst_structure_fixate_field_nearest_int :: 
    Ptr Structure ->                        -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    CString ->                              -- field_name : TBasicType TUTF8
    Int32 ->                                -- target : TBasicType TInt
    IO CInt

-- | Fixates a t'GI.Gst.Structs.Structure.Structure' by changing the given field to the nearest
-- integer to /@target@/ that is a subset of the existing field.
structureFixateFieldNearestInt ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Structure
    -- ^ /@structure@/: a t'GI.Gst.Structs.Structure.Structure'
    -> T.Text
    -- ^ /@fieldName@/: a field in /@structure@/
    -> Int32
    -- ^ /@target@/: the target value of the fixation
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the structure could be fixated
structureFixateFieldNearestInt :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> Text -> Int32 -> m Bool
structureFixateFieldNearestInt Structure
structure Text
fieldName Int32
target = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
structure
    CString
fieldName' <- Text -> IO CString
textToCString Text
fieldName
    CInt
result <- Ptr Structure -> CString -> Int32 -> IO CInt
gst_structure_fixate_field_nearest_int Ptr Structure
structure' CString
fieldName' Int32
target
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
fieldName'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data StructureFixateFieldNearestIntMethodInfo
instance (signature ~ (T.Text -> Int32 -> m Bool), MonadIO m) => O.OverloadedMethod StructureFixateFieldNearestIntMethodInfo Structure signature where
    overloadedMethod = structureFixateFieldNearestInt

instance O.OverloadedMethodInfo StructureFixateFieldNearestIntMethodInfo Structure where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Structs.Structure.structureFixateFieldNearestInt",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Structs-Structure.html#v:structureFixateFieldNearestInt"
        }


#endif

-- method Structure::fixate_field_string
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "field_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a field in @structure"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "target"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the target value of the fixation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_fixate_field_string" gst_structure_fixate_field_string :: 
    Ptr Structure ->                        -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    CString ->                              -- field_name : TBasicType TUTF8
    CString ->                              -- target : TBasicType TUTF8
    IO CInt

-- | Fixates a t'GI.Gst.Structs.Structure.Structure' by changing the given /@fieldName@/ field to the given
-- /@target@/ string if that field is not fixed yet.
structureFixateFieldString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Structure
    -- ^ /@structure@/: a t'GI.Gst.Structs.Structure.Structure'
    -> T.Text
    -- ^ /@fieldName@/: a field in /@structure@/
    -> T.Text
    -- ^ /@target@/: the target value of the fixation
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the structure could be fixated
structureFixateFieldString :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> Text -> Text -> m Bool
structureFixateFieldString Structure
structure Text
fieldName Text
target = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
structure
    CString
fieldName' <- Text -> IO CString
textToCString Text
fieldName
    CString
target' <- Text -> IO CString
textToCString Text
target
    CInt
result <- Ptr Structure -> CString -> CString -> IO CInt
gst_structure_fixate_field_string Ptr Structure
structure' CString
fieldName' CString
target'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
fieldName'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
target'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data StructureFixateFieldStringMethodInfo
instance (signature ~ (T.Text -> T.Text -> m Bool), MonadIO m) => O.OverloadedMethod StructureFixateFieldStringMethodInfo Structure signature where
    overloadedMethod = structureFixateFieldString

instance O.OverloadedMethodInfo StructureFixateFieldStringMethodInfo Structure where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Structs.Structure.structureFixateFieldString",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Structs-Structure.html#v:structureFixateFieldString"
        }


#endif

-- method Structure::foreach
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "func"
--           , argType =
--               TInterface
--                 Name { namespace = "Gst" , name = "StructureForeachFunc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a function to call for each field"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeCall
--           , argClosure = 2
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "private data" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_foreach" gst_structure_foreach :: 
    Ptr Structure ->                        -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    FunPtr Gst.Callbacks.C_StructureForeachFunc -> -- func : TInterface (Name {namespace = "Gst", name = "StructureForeachFunc"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO CInt

-- | Calls the provided function once for each field in the t'GI.Gst.Structs.Structure.Structure'. The
-- function must not modify the fields. Also see 'GI.Gst.Structs.Structure.structureMapInPlace'
-- and 'GI.Gst.Structs.Structure.structureFilterAndMapInPlace'.
structureForeach ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Structure
    -- ^ /@structure@/: a t'GI.Gst.Structs.Structure.Structure'
    -> Gst.Callbacks.StructureForeachFunc
    -- ^ /@func@/: a function to call for each field
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the supplied function returns 'P.True' For each of the fields,
    -- 'P.False' otherwise.
structureForeach :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> StructureFilterMapFunc -> m Bool
structureForeach Structure
structure StructureFilterMapFunc
func = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
structure
    FunPtr C_StructureFilterMapFunc
func' <- C_StructureFilterMapFunc -> IO (FunPtr C_StructureFilterMapFunc)
Gst.Callbacks.mk_StructureForeachFunc (Maybe (Ptr (FunPtr C_StructureFilterMapFunc))
-> StructureFilterMapFunc_WithClosures -> C_StructureFilterMapFunc
Gst.Callbacks.wrap_StructureForeachFunc Maybe (Ptr (FunPtr C_StructureFilterMapFunc))
forall a. Maybe a
Nothing (StructureFilterMapFunc -> StructureFilterMapFunc_WithClosures
Gst.Callbacks.drop_closures_StructureForeachFunc StructureFilterMapFunc
func))
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    CInt
result <- Ptr Structure
-> FunPtr C_StructureFilterMapFunc -> Ptr () -> IO CInt
gst_structure_foreach Ptr Structure
structure' FunPtr C_StructureFilterMapFunc
func' Ptr ()
forall a. Ptr a
userData
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_StructureFilterMapFunc -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_StructureFilterMapFunc
func'
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data StructureForeachMethodInfo
instance (signature ~ (Gst.Callbacks.StructureForeachFunc -> m Bool), MonadIO m) => O.OverloadedMethod StructureForeachMethodInfo Structure signature where
    overloadedMethod = structureForeach

instance O.OverloadedMethodInfo StructureForeachMethodInfo Structure where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Structs.Structure.structureForeach",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Structs-Structure.html#v:structureForeach"
        }


#endif

-- method Structure::free
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstStructure to free"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_free" gst_structure_free :: 
    Ptr Structure ->                        -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    IO ()

-- | Frees a t'GI.Gst.Structs.Structure.Structure' and all its fields and values. The structure must not
-- have a parent when this function is called.
structureFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Structure
    -- ^ /@structure@/: the t'GI.Gst.Structs.Structure.Structure' to free
    -> m ()
structureFree :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> m ()
structureFree Structure
structure = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Structure
structure
    Ptr Structure -> IO ()
gst_structure_free Ptr Structure
structure'
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data StructureFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod StructureFreeMethodInfo Structure signature where
    overloadedMethod = structureFree

instance O.OverloadedMethodInfo StructureFreeMethodInfo Structure where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Structs.Structure.structureFree",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Structs-Structure.html#v:structureFree"
        }


#endif

-- method Structure::get_array
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fieldname"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of a field"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "array"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "ValueArray" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a pointer to a #GValueArray"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_get_array" gst_structure_get_array :: 
    Ptr Structure ->                        -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    CString ->                              -- fieldname : TBasicType TUTF8
    Ptr (Ptr GObject.ValueArray.ValueArray) -> -- array : TInterface (Name {namespace = "GObject", name = "ValueArray"})
    IO CInt

-- | This is useful in language bindings where unknown t'GI.GObject.Structs.Value.Value' types are not
-- supported. This function will convert the @/GST_TYPE_ARRAY/@ into a newly
-- allocated t'GI.GObject.Structs.ValueArray.ValueArray' and return it through /@array@/. Be aware that this is
-- slower then getting the t'GI.GObject.Structs.Value.Value' directly.
-- 
-- /Since: 1.12/
structureGetArray ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Structure
    -- ^ /@structure@/: a t'GI.Gst.Structs.Structure.Structure'
    -> T.Text
    -- ^ /@fieldname@/: the name of a field
    -> m ((Bool, GObject.ValueArray.ValueArray))
    -- ^ __Returns:__ 'P.True' if the value could be set correctly. If there was no field
    -- with /@fieldname@/ or the existing field did not contain a @/GST_TYPE_ARRAY/@,
    -- this function returns 'P.False'.
structureGetArray :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> Text -> m (Bool, ValueArray)
structureGetArray Structure
structure Text
fieldname = IO (Bool, ValueArray) -> m (Bool, ValueArray)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, ValueArray) -> m (Bool, ValueArray))
-> IO (Bool, ValueArray) -> m (Bool, ValueArray)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
structure
    CString
fieldname' <- Text -> IO CString
textToCString Text
fieldname
    Ptr (Ptr ValueArray)
array <- IO (Ptr (Ptr ValueArray))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr GObject.ValueArray.ValueArray))
    CInt
result <- Ptr Structure -> CString -> Ptr (Ptr ValueArray) -> IO CInt
gst_structure_get_array Ptr Structure
structure' CString
fieldname' Ptr (Ptr ValueArray)
array
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Ptr ValueArray
array' <- Ptr (Ptr ValueArray) -> IO (Ptr ValueArray)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr ValueArray)
array
    ValueArray
array'' <- ((ManagedPtr ValueArray -> ValueArray)
-> Ptr ValueArray -> IO ValueArray
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr ValueArray -> ValueArray
GObject.ValueArray.ValueArray) Ptr ValueArray
array'
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
fieldname'
    Ptr (Ptr ValueArray) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr ValueArray)
array
    (Bool, ValueArray) -> IO (Bool, ValueArray)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', ValueArray
array'')

#if defined(ENABLE_OVERLOADING)
data StructureGetArrayMethodInfo
instance (signature ~ (T.Text -> m ((Bool, GObject.ValueArray.ValueArray))), MonadIO m) => O.OverloadedMethod StructureGetArrayMethodInfo Structure signature where
    overloadedMethod = structureGetArray

instance O.OverloadedMethodInfo StructureGetArrayMethodInfo Structure where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Structs.Structure.structureGetArray",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Structs-Structure.html#v:structureGetArray"
        }


#endif

-- method Structure::get_boolean
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fieldname"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of a field"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TBoolean
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a pointer to a #gboolean to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_get_boolean" gst_structure_get_boolean :: 
    Ptr Structure ->                        -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    CString ->                              -- fieldname : TBasicType TUTF8
    Ptr CInt ->                             -- value : TBasicType TBoolean
    IO CInt

-- | Sets the boolean pointed to by /@value@/ corresponding to the value of the
-- given field.  Caller is responsible for making sure the field exists
-- and has the correct type.
structureGetBoolean ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Structure
    -- ^ /@structure@/: a t'GI.Gst.Structs.Structure.Structure'
    -> T.Text
    -- ^ /@fieldname@/: the name of a field
    -> m ((Bool, Bool))
    -- ^ __Returns:__ 'P.True' if the value could be set correctly. If there was no field
    -- with /@fieldname@/ or the existing field did not contain a boolean, this
    -- function returns 'P.False'.
structureGetBoolean :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> Text -> m (Bool, Bool)
structureGetBoolean Structure
structure Text
fieldname = IO (Bool, Bool) -> m (Bool, Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Bool) -> m (Bool, Bool))
-> IO (Bool, Bool) -> m (Bool, Bool)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
structure
    CString
fieldname' <- Text -> IO CString
textToCString Text
fieldname
    Ptr CInt
value <- IO (Ptr CInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CInt)
    CInt
result <- Ptr Structure -> CString -> Ptr CInt -> IO CInt
gst_structure_get_boolean Ptr Structure
structure' CString
fieldname' Ptr CInt
value
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CInt
value' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
value
    let value'' :: Bool
value'' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
value'
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
fieldname'
    Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
value
    (Bool, Bool) -> IO (Bool, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Bool
value'')

#if defined(ENABLE_OVERLOADING)
data StructureGetBooleanMethodInfo
instance (signature ~ (T.Text -> m ((Bool, Bool))), MonadIO m) => O.OverloadedMethod StructureGetBooleanMethodInfo Structure signature where
    overloadedMethod = structureGetBoolean

instance O.OverloadedMethodInfo StructureGetBooleanMethodInfo Structure where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Structs.Structure.structureGetBoolean",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Structs-Structure.html#v:structureGetBoolean"
        }


#endif

-- method Structure::get_clock_time
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fieldname"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of a field"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a pointer to a #GstClockTime to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_get_clock_time" gst_structure_get_clock_time :: 
    Ptr Structure ->                        -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    CString ->                              -- fieldname : TBasicType TUTF8
    Ptr Word64 ->                           -- value : TBasicType TUInt64
    IO CInt

-- | Sets the clock time pointed to by /@value@/ corresponding to the clock time
-- of the given field.  Caller is responsible for making sure the field exists
-- and has the correct type.
structureGetClockTime ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Structure
    -- ^ /@structure@/: a t'GI.Gst.Structs.Structure.Structure'
    -> T.Text
    -- ^ /@fieldname@/: the name of a field
    -> m ((Bool, Word64))
    -- ^ __Returns:__ 'P.True' if the value could be set correctly. If there was no field
    -- with /@fieldname@/ or the existing field did not contain a @/GstClockTime/@, this
    -- function returns 'P.False'.
structureGetClockTime :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> Text -> m (Bool, CGType)
structureGetClockTime Structure
structure Text
fieldname = IO (Bool, CGType) -> m (Bool, CGType)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, CGType) -> m (Bool, CGType))
-> IO (Bool, CGType) -> m (Bool, CGType)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
structure
    CString
fieldname' <- Text -> IO CString
textToCString Text
fieldname
    Ptr CGType
value <- IO (Ptr CGType)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    CInt
result <- Ptr Structure -> CString -> Ptr CGType -> IO CInt
gst_structure_get_clock_time Ptr Structure
structure' CString
fieldname' Ptr CGType
value
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CGType
value' <- Ptr CGType -> IO CGType
forall a. Storable a => Ptr a -> IO a
peek Ptr CGType
value
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
fieldname'
    Ptr CGType -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CGType
value
    (Bool, CGType) -> IO (Bool, CGType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', CGType
value')

#if defined(ENABLE_OVERLOADING)
data StructureGetClockTimeMethodInfo
instance (signature ~ (T.Text -> m ((Bool, Word64))), MonadIO m) => O.OverloadedMethod StructureGetClockTimeMethodInfo Structure signature where
    overloadedMethod = structureGetClockTime

instance O.OverloadedMethodInfo StructureGetClockTimeMethodInfo Structure where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Structs.Structure.structureGetClockTime",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Structs-Structure.html#v:structureGetClockTime"
        }


#endif

-- method Structure::get_date
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fieldname"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of a field"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TInterface Name { namespace = "GLib" , name = "Date" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a pointer to a #GDate to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_get_date" gst_structure_get_date :: 
    Ptr Structure ->                        -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    CString ->                              -- fieldname : TBasicType TUTF8
    Ptr (Ptr GLib.Date.Date) ->             -- value : TInterface (Name {namespace = "GLib", name = "Date"})
    IO CInt

-- | Sets the date pointed to by /@value@/ corresponding to the date of the
-- given field.  Caller is responsible for making sure the field exists
-- and has the correct type.
-- 
-- On success /@value@/ will point to a newly-allocated copy of the date which
-- should be freed with 'GI.GLib.Structs.Date.dateFree' when no longer needed (note: this is
-- inconsistent with e.g. 'GI.Gst.Structs.Structure.structureGetString' which doesn\'t return a
-- copy of the string).
structureGetDate ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Structure
    -- ^ /@structure@/: a t'GI.Gst.Structs.Structure.Structure'
    -> T.Text
    -- ^ /@fieldname@/: the name of a field
    -> m ((Bool, GLib.Date.Date))
    -- ^ __Returns:__ 'P.True' if the value could be set correctly. If there was no field
    -- with /@fieldname@/ or the existing field did not contain a data, this function
    -- returns 'P.False'.
structureGetDate :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> Text -> m (Bool, Date)
structureGetDate Structure
structure Text
fieldname = IO (Bool, Date) -> m (Bool, Date)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Date) -> m (Bool, Date))
-> IO (Bool, Date) -> m (Bool, Date)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
structure
    CString
fieldname' <- Text -> IO CString
textToCString Text
fieldname
    Ptr (Ptr Date)
value <- IO (Ptr (Ptr Date))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr GLib.Date.Date))
    CInt
result <- Ptr Structure -> CString -> Ptr (Ptr Date) -> IO CInt
gst_structure_get_date Ptr Structure
structure' CString
fieldname' Ptr (Ptr Date)
value
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Ptr Date
value' <- Ptr (Ptr Date) -> IO (Ptr Date)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Date)
value
    Date
value'' <- ((ManagedPtr Date -> Date) -> Ptr Date -> IO Date
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Date -> Date
GLib.Date.Date) Ptr Date
value'
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
fieldname'
    Ptr (Ptr Date) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Date)
value
    (Bool, Date) -> IO (Bool, Date)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Date
value'')

#if defined(ENABLE_OVERLOADING)
data StructureGetDateMethodInfo
instance (signature ~ (T.Text -> m ((Bool, GLib.Date.Date))), MonadIO m) => O.OverloadedMethod StructureGetDateMethodInfo Structure signature where
    overloadedMethod = structureGetDate

instance O.OverloadedMethodInfo StructureGetDateMethodInfo Structure where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Structs.Structure.structureGetDate",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Structs-Structure.html#v:structureGetDate"
        }


#endif

-- method Structure::get_date_time
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fieldname"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of a field"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "DateTime" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a pointer to a #GstDateTime to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_get_date_time" gst_structure_get_date_time :: 
    Ptr Structure ->                        -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    CString ->                              -- fieldname : TBasicType TUTF8
    Ptr (Ptr Gst.DateTime.DateTime) ->      -- value : TInterface (Name {namespace = "Gst", name = "DateTime"})
    IO CInt

-- | Sets the datetime pointed to by /@value@/ corresponding to the datetime of the
-- given field. Caller is responsible for making sure the field exists
-- and has the correct type.
-- 
-- On success /@value@/ will point to a reference of the datetime which
-- should be unreffed with 'GI.Gst.Structs.DateTime.dateTimeUnref' when no longer needed
-- (note: this is inconsistent with e.g. 'GI.Gst.Structs.Structure.structureGetString'
-- which doesn\'t return a copy of the string).
structureGetDateTime ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Structure
    -- ^ /@structure@/: a t'GI.Gst.Structs.Structure.Structure'
    -> T.Text
    -- ^ /@fieldname@/: the name of a field
    -> m ((Bool, Gst.DateTime.DateTime))
    -- ^ __Returns:__ 'P.True' if the value could be set correctly. If there was no field
    -- with /@fieldname@/ or the existing field did not contain a data, this function
    -- returns 'P.False'.
structureGetDateTime :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> Text -> m (Bool, DateTime)
structureGetDateTime Structure
structure Text
fieldname = IO (Bool, DateTime) -> m (Bool, DateTime)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, DateTime) -> m (Bool, DateTime))
-> IO (Bool, DateTime) -> m (Bool, DateTime)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
structure
    CString
fieldname' <- Text -> IO CString
textToCString Text
fieldname
    Ptr (Ptr DateTime)
value <- IO (Ptr (Ptr DateTime))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Gst.DateTime.DateTime))
    CInt
result <- Ptr Structure -> CString -> Ptr (Ptr DateTime) -> IO CInt
gst_structure_get_date_time Ptr Structure
structure' CString
fieldname' Ptr (Ptr DateTime)
value
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Ptr DateTime
value' <- Ptr (Ptr DateTime) -> IO (Ptr DateTime)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr DateTime)
value
    DateTime
value'' <- ((ManagedPtr DateTime -> DateTime) -> Ptr DateTime -> IO DateTime
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr DateTime -> DateTime
Gst.DateTime.DateTime) Ptr DateTime
value'
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
fieldname'
    Ptr (Ptr DateTime) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr DateTime)
value
    (Bool, DateTime) -> IO (Bool, DateTime)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', DateTime
value'')

#if defined(ENABLE_OVERLOADING)
data StructureGetDateTimeMethodInfo
instance (signature ~ (T.Text -> m ((Bool, Gst.DateTime.DateTime))), MonadIO m) => O.OverloadedMethod StructureGetDateTimeMethodInfo Structure signature where
    overloadedMethod = structureGetDateTime

instance O.OverloadedMethodInfo StructureGetDateTimeMethodInfo Structure where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Structs.Structure.structureGetDateTime",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Structs-Structure.html#v:structureGetDateTime"
        }


#endif

-- method Structure::get_double
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fieldname"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of a field"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a pointer to a gdouble to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_get_double" gst_structure_get_double :: 
    Ptr Structure ->                        -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    CString ->                              -- fieldname : TBasicType TUTF8
    Ptr CDouble ->                          -- value : TBasicType TDouble
    IO CInt

-- | Sets the double pointed to by /@value@/ corresponding to the value of the
-- given field.  Caller is responsible for making sure the field exists
-- and has the correct type.
structureGetDouble ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Structure
    -- ^ /@structure@/: a t'GI.Gst.Structs.Structure.Structure'
    -> T.Text
    -- ^ /@fieldname@/: the name of a field
    -> m ((Bool, Double))
    -- ^ __Returns:__ 'P.True' if the value could be set correctly. If there was no field
    -- with /@fieldname@/ or the existing field did not contain a double, this
    -- function returns 'P.False'.
structureGetDouble :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> Text -> m (Bool, Double)
structureGetDouble Structure
structure Text
fieldname = IO (Bool, Double) -> m (Bool, Double)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Double) -> m (Bool, Double))
-> IO (Bool, Double) -> m (Bool, Double)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
structure
    CString
fieldname' <- Text -> IO CString
textToCString Text
fieldname
    Ptr CDouble
value <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    CInt
result <- Ptr Structure -> CString -> Ptr CDouble -> IO CInt
gst_structure_get_double Ptr Structure
structure' CString
fieldname' Ptr CDouble
value
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CDouble
value' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
value
    let value'' :: Double
value'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
value'
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
fieldname'
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
value
    (Bool, Double) -> IO (Bool, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Double
value'')

#if defined(ENABLE_OVERLOADING)
data StructureGetDoubleMethodInfo
instance (signature ~ (T.Text -> m ((Bool, Double))), MonadIO m) => O.OverloadedMethod StructureGetDoubleMethodInfo Structure signature where
    overloadedMethod = structureGetDouble

instance O.OverloadedMethodInfo StructureGetDoubleMethodInfo Structure where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Structs.Structure.structureGetDouble",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Structs-Structure.html#v:structureGetDouble"
        }


#endif

-- method Structure::get_enum
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fieldname"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of a field"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "enumtype"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the enum type of a field"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a pointer to an int to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_get_enum" gst_structure_get_enum :: 
    Ptr Structure ->                        -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    CString ->                              -- fieldname : TBasicType TUTF8
    CGType ->                               -- enumtype : TBasicType TGType
    Ptr Int32 ->                            -- value : TBasicType TInt
    IO CInt

-- | Sets the int pointed to by /@value@/ corresponding to the value of the
-- given field.  Caller is responsible for making sure the field exists,
-- has the correct type and that the enumtype is correct.
structureGetEnum ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Structure
    -- ^ /@structure@/: a t'GI.Gst.Structs.Structure.Structure'
    -> T.Text
    -- ^ /@fieldname@/: the name of a field
    -> GType
    -- ^ /@enumtype@/: the enum type of a field
    -> m ((Bool, Int32))
    -- ^ __Returns:__ 'P.True' if the value could be set correctly. If there was no field
    -- with /@fieldname@/ or the existing field did not contain an enum of the given
    -- type, this function returns 'P.False'.
structureGetEnum :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> Text -> GType -> m (Bool, Int32)
structureGetEnum Structure
structure Text
fieldname GType
enumtype = IO (Bool, Int32) -> m (Bool, Int32)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Int32) -> m (Bool, Int32))
-> IO (Bool, Int32) -> m (Bool, Int32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
structure
    CString
fieldname' <- Text -> IO CString
textToCString Text
fieldname
    let enumtype' :: CGType
enumtype' = GType -> CGType
gtypeToCGType GType
enumtype
    Ptr Int32
value <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    CInt
result <- Ptr Structure -> CString -> CGType -> Ptr Int32 -> IO CInt
gst_structure_get_enum Ptr Structure
structure' CString
fieldname' CGType
enumtype' Ptr Int32
value
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Int32
value' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
value
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
fieldname'
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
value
    (Bool, Int32) -> IO (Bool, Int32)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Int32
value')

#if defined(ENABLE_OVERLOADING)
data StructureGetEnumMethodInfo
instance (signature ~ (T.Text -> GType -> m ((Bool, Int32))), MonadIO m) => O.OverloadedMethod StructureGetEnumMethodInfo Structure signature where
    overloadedMethod = structureGetEnum

instance O.OverloadedMethodInfo StructureGetEnumMethodInfo Structure where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Structs.Structure.structureGetEnum",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Structs-Structure.html#v:structureGetEnum"
        }


#endif

-- method Structure::get_field_type
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fieldname"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the field"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TGType)
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_get_field_type" gst_structure_get_field_type :: 
    Ptr Structure ->                        -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    CString ->                              -- fieldname : TBasicType TUTF8
    IO CGType

-- | Finds the field with the given name, and returns the type of the
-- value it contains.  If the field is not found, G_TYPE_INVALID is
-- returned.
structureGetFieldType ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Structure
    -- ^ /@structure@/: a t'GI.Gst.Structs.Structure.Structure'
    -> T.Text
    -- ^ /@fieldname@/: the name of the field
    -> m GType
    -- ^ __Returns:__ the t'GI.GObject.Structs.Value.Value' of the field
structureGetFieldType :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> Text -> m GType
structureGetFieldType Structure
structure Text
fieldname = IO GType -> m GType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GType -> m GType) -> IO GType -> m GType
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
structure
    CString
fieldname' <- Text -> IO CString
textToCString Text
fieldname
    CGType
result <- Ptr Structure -> CString -> IO CGType
gst_structure_get_field_type Ptr Structure
structure' CString
fieldname'
    let result' :: GType
result' = CGType -> GType
GType CGType
result
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
fieldname'
    GType -> IO GType
forall (m :: * -> *) a. Monad m => a -> m a
return GType
result'

#if defined(ENABLE_OVERLOADING)
data StructureGetFieldTypeMethodInfo
instance (signature ~ (T.Text -> m GType), MonadIO m) => O.OverloadedMethod StructureGetFieldTypeMethodInfo Structure signature where
    overloadedMethod = structureGetFieldType

instance O.OverloadedMethodInfo StructureGetFieldTypeMethodInfo Structure where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Structs.Structure.structureGetFieldType",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Structs-Structure.html#v:structureGetFieldType"
        }


#endif

-- method Structure::get_flagset
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fieldname"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of a field"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value_flags"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a pointer to a guint for the flags field"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "value_mask"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a pointer to a guint for the mask field"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_get_flagset" gst_structure_get_flagset :: 
    Ptr Structure ->                        -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    CString ->                              -- fieldname : TBasicType TUTF8
    Ptr Word32 ->                           -- value_flags : TBasicType TUInt
    Ptr Word32 ->                           -- value_mask : TBasicType TUInt
    IO CInt

-- | Read the GstFlagSet flags and mask out of the structure into the
-- provided pointers.
-- 
-- /Since: 1.6/
structureGetFlagset ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Structure
    -- ^ /@structure@/: a t'GI.Gst.Structs.Structure.Structure'
    -> T.Text
    -- ^ /@fieldname@/: the name of a field
    -> m ((Bool, Word32, Word32))
    -- ^ __Returns:__ 'P.True' if the values could be set correctly. If there was no field
    -- with /@fieldname@/ or the existing field did not contain a GstFlagSet, this
    -- function returns 'P.False'.
structureGetFlagset :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> Text -> m (Bool, Word32, Word32)
structureGetFlagset Structure
structure Text
fieldname = IO (Bool, Word32, Word32) -> m (Bool, Word32, Word32)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Word32, Word32) -> m (Bool, Word32, Word32))
-> IO (Bool, Word32, Word32) -> m (Bool, Word32, Word32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
structure
    CString
fieldname' <- Text -> IO CString
textToCString Text
fieldname
    Ptr Word32
valueFlags <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    Ptr Word32
valueMask <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    CInt
result <- Ptr Structure -> CString -> Ptr Word32 -> Ptr Word32 -> IO CInt
gst_structure_get_flagset Ptr Structure
structure' CString
fieldname' Ptr Word32
valueFlags Ptr Word32
valueMask
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Word32
valueFlags' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
valueFlags
    Word32
valueMask' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
valueMask
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
fieldname'
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
valueFlags
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
valueMask
    (Bool, Word32, Word32) -> IO (Bool, Word32, Word32)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Word32
valueFlags', Word32
valueMask')

#if defined(ENABLE_OVERLOADING)
data StructureGetFlagsetMethodInfo
instance (signature ~ (T.Text -> m ((Bool, Word32, Word32))), MonadIO m) => O.OverloadedMethod StructureGetFlagsetMethodInfo Structure signature where
    overloadedMethod = structureGetFlagset

instance O.OverloadedMethodInfo StructureGetFlagsetMethodInfo Structure where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Structs.Structure.structureGetFlagset",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Structs-Structure.html#v:structureGetFlagset"
        }


#endif

-- method Structure::get_fraction
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fieldname"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of a field"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value_numerator"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a pointer to an int to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "value_denominator"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a pointer to an int to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_get_fraction" gst_structure_get_fraction :: 
    Ptr Structure ->                        -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    CString ->                              -- fieldname : TBasicType TUTF8
    Ptr Int32 ->                            -- value_numerator : TBasicType TInt
    Ptr Int32 ->                            -- value_denominator : TBasicType TInt
    IO CInt

-- | Sets the integers pointed to by /@valueNumerator@/ and /@valueDenominator@/
-- corresponding to the value of the given field.  Caller is responsible
-- for making sure the field exists and has the correct type.
structureGetFraction ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Structure
    -- ^ /@structure@/: a t'GI.Gst.Structs.Structure.Structure'
    -> T.Text
    -- ^ /@fieldname@/: the name of a field
    -> m ((Bool, Int32, Int32))
    -- ^ __Returns:__ 'P.True' if the values could be set correctly. If there was no field
    -- with /@fieldname@/ or the existing field did not contain a GstFraction, this
    -- function returns 'P.False'.
structureGetFraction :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> Text -> m (Bool, Int32, Int32)
structureGetFraction Structure
structure Text
fieldname = IO (Bool, Int32, Int32) -> m (Bool, Int32, Int32)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Int32, Int32) -> m (Bool, Int32, Int32))
-> IO (Bool, Int32, Int32) -> m (Bool, Int32, Int32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
structure
    CString
fieldname' <- Text -> IO CString
textToCString Text
fieldname
    Ptr Int32
valueNumerator <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr Int32
valueDenominator <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    CInt
result <- Ptr Structure -> CString -> Ptr Int32 -> Ptr Int32 -> IO CInt
gst_structure_get_fraction Ptr Structure
structure' CString
fieldname' Ptr Int32
valueNumerator Ptr Int32
valueDenominator
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Int32
valueNumerator' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
valueNumerator
    Int32
valueDenominator' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
valueDenominator
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
fieldname'
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
valueNumerator
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
valueDenominator
    (Bool, Int32, Int32) -> IO (Bool, Int32, Int32)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Int32
valueNumerator', Int32
valueDenominator')

#if defined(ENABLE_OVERLOADING)
data StructureGetFractionMethodInfo
instance (signature ~ (T.Text -> m ((Bool, Int32, Int32))), MonadIO m) => O.OverloadedMethod StructureGetFractionMethodInfo Structure signature where
    overloadedMethod = structureGetFraction

instance O.OverloadedMethodInfo StructureGetFractionMethodInfo Structure where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Structs.Structure.structureGetFraction",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Structs-Structure.html#v:structureGetFraction"
        }


#endif

-- method Structure::get_int
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fieldname"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of a field"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a pointer to an int to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_get_int" gst_structure_get_int :: 
    Ptr Structure ->                        -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    CString ->                              -- fieldname : TBasicType TUTF8
    Ptr Int32 ->                            -- value : TBasicType TInt
    IO CInt

-- | Sets the int pointed to by /@value@/ corresponding to the value of the
-- given field.  Caller is responsible for making sure the field exists
-- and has the correct type.
structureGetInt ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Structure
    -- ^ /@structure@/: a t'GI.Gst.Structs.Structure.Structure'
    -> T.Text
    -- ^ /@fieldname@/: the name of a field
    -> m ((Bool, Int32))
    -- ^ __Returns:__ 'P.True' if the value could be set correctly. If there was no field
    -- with /@fieldname@/ or the existing field did not contain an int, this function
    -- returns 'P.False'.
structureGetInt :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> Text -> m (Bool, Int32)
structureGetInt Structure
structure Text
fieldname = IO (Bool, Int32) -> m (Bool, Int32)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Int32) -> m (Bool, Int32))
-> IO (Bool, Int32) -> m (Bool, Int32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
structure
    CString
fieldname' <- Text -> IO CString
textToCString Text
fieldname
    Ptr Int32
value <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    CInt
result <- Ptr Structure -> CString -> Ptr Int32 -> IO CInt
gst_structure_get_int Ptr Structure
structure' CString
fieldname' Ptr Int32
value
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Int32
value' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
value
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
fieldname'
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
value
    (Bool, Int32) -> IO (Bool, Int32)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Int32
value')

#if defined(ENABLE_OVERLOADING)
data StructureGetIntMethodInfo
instance (signature ~ (T.Text -> m ((Bool, Int32))), MonadIO m) => O.OverloadedMethod StructureGetIntMethodInfo Structure signature where
    overloadedMethod = structureGetInt

instance O.OverloadedMethodInfo StructureGetIntMethodInfo Structure where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Structs.Structure.structureGetInt",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Structs-Structure.html#v:structureGetInt"
        }


#endif

-- method Structure::get_int64
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fieldname"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of a field"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a pointer to a #gint64 to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_get_int64" gst_structure_get_int64 :: 
    Ptr Structure ->                        -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    CString ->                              -- fieldname : TBasicType TUTF8
    Ptr Int64 ->                            -- value : TBasicType TInt64
    IO CInt

-- | Sets the @/gint64/@ pointed to by /@value@/ corresponding to the value of the
-- given field. Caller is responsible for making sure the field exists
-- and has the correct type.
-- 
-- /Since: 1.4/
structureGetInt64 ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Structure
    -- ^ /@structure@/: a t'GI.Gst.Structs.Structure.Structure'
    -> T.Text
    -- ^ /@fieldname@/: the name of a field
    -> m ((Bool, Int64))
    -- ^ __Returns:__ 'P.True' if the value could be set correctly. If there was no field
    -- with /@fieldname@/ or the existing field did not contain a @/gint64/@, this function
    -- returns 'P.False'.
structureGetInt64 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> Text -> m (Bool, Int64)
structureGetInt64 Structure
structure Text
fieldname = IO (Bool, Int64) -> m (Bool, Int64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Int64) -> m (Bool, Int64))
-> IO (Bool, Int64) -> m (Bool, Int64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
structure
    CString
fieldname' <- Text -> IO CString
textToCString Text
fieldname
    Ptr Int64
value <- IO (Ptr Int64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int64)
    CInt
result <- Ptr Structure -> CString -> Ptr Int64 -> IO CInt
gst_structure_get_int64 Ptr Structure
structure' CString
fieldname' Ptr Int64
value
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Int64
value' <- Ptr Int64 -> IO Int64
forall a. Storable a => Ptr a -> IO a
peek Ptr Int64
value
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
fieldname'
    Ptr Int64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int64
value
    (Bool, Int64) -> IO (Bool, Int64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Int64
value')

#if defined(ENABLE_OVERLOADING)
data StructureGetInt64MethodInfo
instance (signature ~ (T.Text -> m ((Bool, Int64))), MonadIO m) => O.OverloadedMethod StructureGetInt64MethodInfo Structure signature where
    overloadedMethod = structureGetInt64

instance O.OverloadedMethodInfo StructureGetInt64MethodInfo Structure where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Structs.Structure.structureGetInt64",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Structs-Structure.html#v:structureGetInt64"
        }


#endif

-- method Structure::get_list
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fieldname"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of a field"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "array"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "ValueArray" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a pointer to a #GValueArray"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_get_list" gst_structure_get_list :: 
    Ptr Structure ->                        -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    CString ->                              -- fieldname : TBasicType TUTF8
    Ptr (Ptr GObject.ValueArray.ValueArray) -> -- array : TInterface (Name {namespace = "GObject", name = "ValueArray"})
    IO CInt

-- | This is useful in language bindings where unknown t'GI.GObject.Structs.Value.Value' types are not
-- supported. This function will convert the @/GST_TYPE_LIST/@ into a newly
-- allocated GValueArray and return it through /@array@/. Be aware that this is
-- slower then getting the t'GI.GObject.Structs.Value.Value' directly.
-- 
-- /Since: 1.12/
structureGetList ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Structure
    -- ^ /@structure@/: a t'GI.Gst.Structs.Structure.Structure'
    -> T.Text
    -- ^ /@fieldname@/: the name of a field
    -> m ((Bool, GObject.ValueArray.ValueArray))
    -- ^ __Returns:__ 'P.True' if the value could be set correctly. If there was no field
    -- with /@fieldname@/ or the existing field did not contain a @/GST_TYPE_LIST/@, this
    -- function returns 'P.False'.
structureGetList :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> Text -> m (Bool, ValueArray)
structureGetList Structure
structure Text
fieldname = IO (Bool, ValueArray) -> m (Bool, ValueArray)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, ValueArray) -> m (Bool, ValueArray))
-> IO (Bool, ValueArray) -> m (Bool, ValueArray)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
structure
    CString
fieldname' <- Text -> IO CString
textToCString Text
fieldname
    Ptr (Ptr ValueArray)
array <- IO (Ptr (Ptr ValueArray))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr GObject.ValueArray.ValueArray))
    CInt
result <- Ptr Structure -> CString -> Ptr (Ptr ValueArray) -> IO CInt
gst_structure_get_list Ptr Structure
structure' CString
fieldname' Ptr (Ptr ValueArray)
array
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Ptr ValueArray
array' <- Ptr (Ptr ValueArray) -> IO (Ptr ValueArray)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr ValueArray)
array
    ValueArray
array'' <- ((ManagedPtr ValueArray -> ValueArray)
-> Ptr ValueArray -> IO ValueArray
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr ValueArray -> ValueArray
GObject.ValueArray.ValueArray) Ptr ValueArray
array'
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
fieldname'
    Ptr (Ptr ValueArray) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr ValueArray)
array
    (Bool, ValueArray) -> IO (Bool, ValueArray)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', ValueArray
array'')

#if defined(ENABLE_OVERLOADING)
data StructureGetListMethodInfo
instance (signature ~ (T.Text -> m ((Bool, GObject.ValueArray.ValueArray))), MonadIO m) => O.OverloadedMethod StructureGetListMethodInfo Structure signature where
    overloadedMethod = structureGetList

instance O.OverloadedMethodInfo StructureGetListMethodInfo Structure where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Structs.Structure.structureGetList",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Structs-Structure.html#v:structureGetList"
        }


#endif

-- method Structure::get_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_get_name" gst_structure_get_name :: 
    Ptr Structure ->                        -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    IO CString

-- | Get the name of /@structure@/ as a string.
structureGetName ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Structure
    -- ^ /@structure@/: a t'GI.Gst.Structs.Structure.Structure'
    -> m T.Text
    -- ^ __Returns:__ the name of the structure.
structureGetName :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> m Text
structureGetName Structure
structure = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
structure
    CString
result <- Ptr Structure -> IO CString
gst_structure_get_name Ptr Structure
structure'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"structureGetName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data StructureGetNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod StructureGetNameMethodInfo Structure signature where
    overloadedMethod = structureGetName

instance O.OverloadedMethodInfo StructureGetNameMethodInfo Structure where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Structs.Structure.structureGetName",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Structs-Structure.html#v:structureGetName"
        }


#endif

-- method Structure::get_name_id
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt32)
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_get_name_id" gst_structure_get_name_id :: 
    Ptr Structure ->                        -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    IO Word32

-- | Get the name of /@structure@/ as a GQuark.
structureGetNameId ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Structure
    -- ^ /@structure@/: a t'GI.Gst.Structs.Structure.Structure'
    -> m Word32
    -- ^ __Returns:__ the quark representing the name of the structure.
structureGetNameId :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> m Word32
structureGetNameId Structure
structure = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
structure
    Word32
result <- Ptr Structure -> IO Word32
gst_structure_get_name_id Ptr Structure
structure'
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data StructureGetNameIdMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.OverloadedMethod StructureGetNameIdMethodInfo Structure signature where
    overloadedMethod = structureGetNameId

instance O.OverloadedMethodInfo StructureGetNameIdMethodInfo Structure where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Structs.Structure.structureGetNameId",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Structs-Structure.html#v:structureGetNameId"
        }


#endif

-- method Structure::get_string
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fieldname"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of a field"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_get_string" gst_structure_get_string :: 
    Ptr Structure ->                        -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    CString ->                              -- fieldname : TBasicType TUTF8
    IO CString

-- | Finds the field corresponding to /@fieldname@/, and returns the string
-- contained in the field\'s value.  Caller is responsible for making
-- sure the field exists and has the correct type.
-- 
-- The string should not be modified, and remains valid until the next
-- call to a gst_structure_*() function with the given structure.
structureGetString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Structure
    -- ^ /@structure@/: a t'GI.Gst.Structs.Structure.Structure'
    -> T.Text
    -- ^ /@fieldname@/: the name of a field
    -> m (Maybe T.Text)
    -- ^ __Returns:__ a pointer to the string or 'P.Nothing' when the
    -- field did not exist or did not contain a string.
structureGetString :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> Text -> m (Maybe Text)
structureGetString Structure
structure Text
fieldname = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
structure
    CString
fieldname' <- Text -> IO CString
textToCString Text
fieldname
    CString
result <- Ptr Structure -> CString -> IO CString
gst_structure_get_string Ptr Structure
structure' CString
fieldname'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
fieldname'
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data StructureGetStringMethodInfo
instance (signature ~ (T.Text -> m (Maybe T.Text)), MonadIO m) => O.OverloadedMethod StructureGetStringMethodInfo Structure signature where
    overloadedMethod = structureGetString

instance O.OverloadedMethodInfo StructureGetStringMethodInfo Structure where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Structs.Structure.structureGetString",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Structs-Structure.html#v:structureGetString"
        }


#endif

-- method Structure::get_uint
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fieldname"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of a field"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a pointer to a uint to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_get_uint" gst_structure_get_uint :: 
    Ptr Structure ->                        -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    CString ->                              -- fieldname : TBasicType TUTF8
    Ptr Word32 ->                           -- value : TBasicType TUInt
    IO CInt

-- | Sets the uint pointed to by /@value@/ corresponding to the value of the
-- given field.  Caller is responsible for making sure the field exists
-- and has the correct type.
structureGetUint ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Structure
    -- ^ /@structure@/: a t'GI.Gst.Structs.Structure.Structure'
    -> T.Text
    -- ^ /@fieldname@/: the name of a field
    -> m ((Bool, Word32))
    -- ^ __Returns:__ 'P.True' if the value could be set correctly. If there was no field
    -- with /@fieldname@/ or the existing field did not contain a uint, this function
    -- returns 'P.False'.
structureGetUint :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> Text -> m (Bool, Word32)
structureGetUint Structure
structure Text
fieldname = IO (Bool, Word32) -> m (Bool, Word32)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Word32) -> m (Bool, Word32))
-> IO (Bool, Word32) -> m (Bool, Word32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
structure
    CString
fieldname' <- Text -> IO CString
textToCString Text
fieldname
    Ptr Word32
value <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    CInt
result <- Ptr Structure -> CString -> Ptr Word32 -> IO CInt
gst_structure_get_uint Ptr Structure
structure' CString
fieldname' Ptr Word32
value
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Word32
value' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
value
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
fieldname'
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
value
    (Bool, Word32) -> IO (Bool, Word32)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Word32
value')

#if defined(ENABLE_OVERLOADING)
data StructureGetUintMethodInfo
instance (signature ~ (T.Text -> m ((Bool, Word32))), MonadIO m) => O.OverloadedMethod StructureGetUintMethodInfo Structure signature where
    overloadedMethod = structureGetUint

instance O.OverloadedMethodInfo StructureGetUintMethodInfo Structure where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Structs.Structure.structureGetUint",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Structs-Structure.html#v:structureGetUint"
        }


#endif

-- method Structure::get_uint64
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fieldname"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of a field"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a pointer to a #guint64 to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_get_uint64" gst_structure_get_uint64 :: 
    Ptr Structure ->                        -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    CString ->                              -- fieldname : TBasicType TUTF8
    Ptr Word64 ->                           -- value : TBasicType TUInt64
    IO CInt

-- | Sets the @/guint64/@ pointed to by /@value@/ corresponding to the value of the
-- given field. Caller is responsible for making sure the field exists
-- and has the correct type.
-- 
-- /Since: 1.4/
structureGetUint64 ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Structure
    -- ^ /@structure@/: a t'GI.Gst.Structs.Structure.Structure'
    -> T.Text
    -- ^ /@fieldname@/: the name of a field
    -> m ((Bool, Word64))
    -- ^ __Returns:__ 'P.True' if the value could be set correctly. If there was no field
    -- with /@fieldname@/ or the existing field did not contain a @/guint64/@, this function
    -- returns 'P.False'.
structureGetUint64 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> Text -> m (Bool, CGType)
structureGetUint64 Structure
structure Text
fieldname = IO (Bool, CGType) -> m (Bool, CGType)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, CGType) -> m (Bool, CGType))
-> IO (Bool, CGType) -> m (Bool, CGType)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
structure
    CString
fieldname' <- Text -> IO CString
textToCString Text
fieldname
    Ptr CGType
value <- IO (Ptr CGType)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    CInt
result <- Ptr Structure -> CString -> Ptr CGType -> IO CInt
gst_structure_get_uint64 Ptr Structure
structure' CString
fieldname' Ptr CGType
value
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CGType
value' <- Ptr CGType -> IO CGType
forall a. Storable a => Ptr a -> IO a
peek Ptr CGType
value
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
fieldname'
    Ptr CGType -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CGType
value
    (Bool, CGType) -> IO (Bool, CGType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', CGType
value')

#if defined(ENABLE_OVERLOADING)
data StructureGetUint64MethodInfo
instance (signature ~ (T.Text -> m ((Bool, Word64))), MonadIO m) => O.OverloadedMethod StructureGetUint64MethodInfo Structure signature where
    overloadedMethod = structureGetUint64

instance O.OverloadedMethodInfo StructureGetUint64MethodInfo Structure where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Structs.Structure.structureGetUint64",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Structs-Structure.html#v:structureGetUint64"
        }


#endif

-- method Structure::get_value
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fieldname"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the field to get"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just TGValue
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_get_value" gst_structure_get_value :: 
    Ptr Structure ->                        -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    CString ->                              -- fieldname : TBasicType TUTF8
    IO (Ptr GValue)

-- | Get the value of the field with name /@fieldname@/.
structureGetValue ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Structure
    -- ^ /@structure@/: a t'GI.Gst.Structs.Structure.Structure'
    -> T.Text
    -- ^ /@fieldname@/: the name of the field to get
    -> m (Maybe GValue)
    -- ^ __Returns:__ the t'GI.GObject.Structs.Value.Value' corresponding to the field with the given
    -- name.
structureGetValue :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> Text -> m (Maybe GValue)
structureGetValue Structure
structure Text
fieldname = IO (Maybe GValue) -> m (Maybe GValue)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe GValue) -> m (Maybe GValue))
-> IO (Maybe GValue) -> m (Maybe GValue)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
structure
    CString
fieldname' <- Text -> IO CString
textToCString Text
fieldname
    Ptr GValue
result <- Ptr Structure -> CString -> IO (Ptr GValue)
gst_structure_get_value Ptr Structure
structure' CString
fieldname'
    Maybe GValue
maybeResult <- Ptr GValue -> (Ptr GValue -> IO GValue) -> IO (Maybe GValue)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr GValue
result ((Ptr GValue -> IO GValue) -> IO (Maybe GValue))
-> (Ptr GValue -> IO GValue) -> IO (Maybe GValue)
forall a b. (a -> b) -> a -> b
$ \Ptr GValue
result' -> do
        GValue
result'' <- Ptr GValue -> IO GValue
B.GValue.newGValueFromPtr Ptr GValue
result'
        GValue -> IO GValue
forall (m :: * -> *) a. Monad m => a -> m a
return GValue
result''
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
fieldname'
    Maybe GValue -> IO (Maybe GValue)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GValue
maybeResult

#if defined(ENABLE_OVERLOADING)
data StructureGetValueMethodInfo
instance (signature ~ (T.Text -> m (Maybe GValue)), MonadIO m) => O.OverloadedMethod StructureGetValueMethodInfo Structure signature where
    overloadedMethod = structureGetValue

instance O.OverloadedMethodInfo StructureGetValueMethodInfo Structure where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Structs.Structure.structureGetValue",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Structs-Structure.html#v:structureGetValue"
        }


#endif

-- method Structure::has_field
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fieldname"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of a field"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_has_field" gst_structure_has_field :: 
    Ptr Structure ->                        -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    CString ->                              -- fieldname : TBasicType TUTF8
    IO CInt

-- | Check if /@structure@/ contains a field named /@fieldname@/.
structureHasField ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Structure
    -- ^ /@structure@/: a t'GI.Gst.Structs.Structure.Structure'
    -> T.Text
    -- ^ /@fieldname@/: the name of a field
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the structure contains a field with the given name
structureHasField :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> Text -> m Bool
structureHasField Structure
structure Text
fieldname = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
structure
    CString
fieldname' <- Text -> IO CString
textToCString Text
fieldname
    CInt
result <- Ptr Structure -> CString -> IO CInt
gst_structure_has_field Ptr Structure
structure' CString
fieldname'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
fieldname'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data StructureHasFieldMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m) => O.OverloadedMethod StructureHasFieldMethodInfo Structure signature where
    overloadedMethod = structureHasField

instance O.OverloadedMethodInfo StructureHasFieldMethodInfo Structure where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Structs.Structure.structureHasField",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Structs-Structure.html#v:structureHasField"
        }


#endif

-- method Structure::has_field_typed
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fieldname"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of a field"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "type"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the type of a value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_has_field_typed" gst_structure_has_field_typed :: 
    Ptr Structure ->                        -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    CString ->                              -- fieldname : TBasicType TUTF8
    CGType ->                               -- type : TBasicType TGType
    IO CInt

-- | Check if /@structure@/ contains a field named /@fieldname@/ and with GType /@type@/.
structureHasFieldTyped ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Structure
    -- ^ /@structure@/: a t'GI.Gst.Structs.Structure.Structure'
    -> T.Text
    -- ^ /@fieldname@/: the name of a field
    -> GType
    -- ^ /@type@/: the type of a value
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the structure contains a field with the given name and type
structureHasFieldTyped :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> Text -> GType -> m Bool
structureHasFieldTyped Structure
structure Text
fieldname GType
type_ = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
structure
    CString
fieldname' <- Text -> IO CString
textToCString Text
fieldname
    let type_' :: CGType
type_' = GType -> CGType
gtypeToCGType GType
type_
    CInt
result <- Ptr Structure -> CString -> CGType -> IO CInt
gst_structure_has_field_typed Ptr Structure
structure' CString
fieldname' CGType
type_'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
fieldname'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data StructureHasFieldTypedMethodInfo
instance (signature ~ (T.Text -> GType -> m Bool), MonadIO m) => O.OverloadedMethod StructureHasFieldTypedMethodInfo Structure signature where
    overloadedMethod = structureHasFieldTyped

instance O.OverloadedMethodInfo StructureHasFieldTypedMethodInfo Structure where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Structs.Structure.structureHasFieldTyped",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Structs-Structure.html#v:structureHasFieldTyped"
        }


#endif

-- method Structure::has_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "structure name to check for"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_has_name" gst_structure_has_name :: 
    Ptr Structure ->                        -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    CString ->                              -- name : TBasicType TUTF8
    IO CInt

-- | Checks if the structure has the given name
structureHasName ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Structure
    -- ^ /@structure@/: a t'GI.Gst.Structs.Structure.Structure'
    -> T.Text
    -- ^ /@name@/: structure name to check for
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@name@/ matches the name of the structure.
structureHasName :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> Text -> m Bool
structureHasName Structure
structure Text
name = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
structure
    CString
name' <- Text -> IO CString
textToCString Text
name
    CInt
result <- Ptr Structure -> CString -> IO CInt
gst_structure_has_name Ptr Structure
structure' CString
name'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data StructureHasNameMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m) => O.OverloadedMethod StructureHasNameMethodInfo Structure signature where
    overloadedMethod = structureHasName

instance O.OverloadedMethodInfo StructureHasNameMethodInfo Structure where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Structs.Structure.structureHasName",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Structs-Structure.html#v:structureHasName"
        }


#endif

-- method Structure::id_get_value
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "field"
--           , argType = TBasicType TUInt32
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GQuark of the field to get"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just TGValue
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_id_get_value" gst_structure_id_get_value :: 
    Ptr Structure ->                        -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    Word32 ->                               -- field : TBasicType TUInt32
    IO (Ptr GValue)

-- | Get the value of the field with GQuark /@field@/.
structureIdGetValue ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Structure
    -- ^ /@structure@/: a t'GI.Gst.Structs.Structure.Structure'
    -> Word32
    -- ^ /@field@/: the @/GQuark/@ of the field to get
    -> m (Maybe GValue)
    -- ^ __Returns:__ the t'GI.GObject.Structs.Value.Value' corresponding to the field with the given
    -- name identifier.
structureIdGetValue :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> Word32 -> m (Maybe GValue)
structureIdGetValue Structure
structure Word32
field = IO (Maybe GValue) -> m (Maybe GValue)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe GValue) -> m (Maybe GValue))
-> IO (Maybe GValue) -> m (Maybe GValue)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
structure
    Ptr GValue
result <- Ptr Structure -> Word32 -> IO (Ptr GValue)
gst_structure_id_get_value Ptr Structure
structure' Word32
field
    Maybe GValue
maybeResult <- Ptr GValue -> (Ptr GValue -> IO GValue) -> IO (Maybe GValue)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr GValue
result ((Ptr GValue -> IO GValue) -> IO (Maybe GValue))
-> (Ptr GValue -> IO GValue) -> IO (Maybe GValue)
forall a b. (a -> b) -> a -> b
$ \Ptr GValue
result' -> do
        GValue
result'' <- Ptr GValue -> IO GValue
B.GValue.newGValueFromPtr Ptr GValue
result'
        GValue -> IO GValue
forall (m :: * -> *) a. Monad m => a -> m a
return GValue
result''
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    Maybe GValue -> IO (Maybe GValue)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GValue
maybeResult

#if defined(ENABLE_OVERLOADING)
data StructureIdGetValueMethodInfo
instance (signature ~ (Word32 -> m (Maybe GValue)), MonadIO m) => O.OverloadedMethod StructureIdGetValueMethodInfo Structure signature where
    overloadedMethod = structureIdGetValue

instance O.OverloadedMethodInfo StructureIdGetValueMethodInfo Structure where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Structs.Structure.structureIdGetValue",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Structs-Structure.html#v:structureIdGetValue"
        }


#endif

-- method Structure::id_has_field
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "field"
--           , argType = TBasicType TUInt32
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GQuark of the field name"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_id_has_field" gst_structure_id_has_field :: 
    Ptr Structure ->                        -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    Word32 ->                               -- field : TBasicType TUInt32
    IO CInt

-- | Check if /@structure@/ contains a field named /@field@/.
structureIdHasField ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Structure
    -- ^ /@structure@/: a t'GI.Gst.Structs.Structure.Structure'
    -> Word32
    -- ^ /@field@/: @/GQuark/@ of the field name
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the structure contains a field with the given name
structureIdHasField :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> Word32 -> m Bool
structureIdHasField Structure
structure Word32
field = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
structure
    CInt
result <- Ptr Structure -> Word32 -> IO CInt
gst_structure_id_has_field Ptr Structure
structure' Word32
field
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data StructureIdHasFieldMethodInfo
instance (signature ~ (Word32 -> m Bool), MonadIO m) => O.OverloadedMethod StructureIdHasFieldMethodInfo Structure signature where
    overloadedMethod = structureIdHasField

instance O.OverloadedMethodInfo StructureIdHasFieldMethodInfo Structure where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Structs.Structure.structureIdHasField",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Structs-Structure.html#v:structureIdHasField"
        }


#endif

-- method Structure::id_has_field_typed
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "field"
--           , argType = TBasicType TUInt32
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GQuark of the field name"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "type"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the type of a value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_id_has_field_typed" gst_structure_id_has_field_typed :: 
    Ptr Structure ->                        -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    Word32 ->                               -- field : TBasicType TUInt32
    CGType ->                               -- type : TBasicType TGType
    IO CInt

-- | Check if /@structure@/ contains a field named /@field@/ and with GType /@type@/.
structureIdHasFieldTyped ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Structure
    -- ^ /@structure@/: a t'GI.Gst.Structs.Structure.Structure'
    -> Word32
    -- ^ /@field@/: @/GQuark/@ of the field name
    -> GType
    -- ^ /@type@/: the type of a value
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the structure contains a field with the given name and type
structureIdHasFieldTyped :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> Word32 -> GType -> m Bool
structureIdHasFieldTyped Structure
structure Word32
field GType
type_ = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
structure
    let type_' :: CGType
type_' = GType -> CGType
gtypeToCGType GType
type_
    CInt
result <- Ptr Structure -> Word32 -> CGType -> IO CInt
gst_structure_id_has_field_typed Ptr Structure
structure' Word32
field CGType
type_'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data StructureIdHasFieldTypedMethodInfo
instance (signature ~ (Word32 -> GType -> m Bool), MonadIO m) => O.OverloadedMethod StructureIdHasFieldTypedMethodInfo Structure signature where
    overloadedMethod = structureIdHasFieldTyped

instance O.OverloadedMethodInfo StructureIdHasFieldTypedMethodInfo Structure where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Structs.Structure.structureIdHasFieldTyped",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Structs-Structure.html#v:structureIdHasFieldTyped"
        }


#endif

-- method Structure::id_set_value
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "field"
--           , argType = TBasicType TUInt32
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GQuark representing a field"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new value of the field"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_id_set_value" gst_structure_id_set_value :: 
    Ptr Structure ->                        -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    Word32 ->                               -- field : TBasicType TUInt32
    Ptr GValue ->                           -- value : TGValue
    IO ()

-- | Sets the field with the given GQuark /@field@/ to /@value@/.  If the field
-- does not exist, it is created.  If the field exists, the previous
-- value is replaced and freed.
structureIdSetValue ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Structure
    -- ^ /@structure@/: a t'GI.Gst.Structs.Structure.Structure'
    -> Word32
    -- ^ /@field@/: a @/GQuark/@ representing a field
    -> GValue
    -- ^ /@value@/: the new value of the field
    -> m ()
structureIdSetValue :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> Word32 -> GValue -> m ()
structureIdSetValue Structure
structure Word32
field GValue
value = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
structure
    Ptr GValue
value' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
value
    Ptr Structure -> Word32 -> Ptr GValue -> IO ()
gst_structure_id_set_value Ptr Structure
structure' Word32
field Ptr GValue
value'
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
value
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data StructureIdSetValueMethodInfo
instance (signature ~ (Word32 -> GValue -> m ()), MonadIO m) => O.OverloadedMethod StructureIdSetValueMethodInfo Structure signature where
    overloadedMethod = structureIdSetValue

instance O.OverloadedMethodInfo StructureIdSetValueMethodInfo Structure where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Structs.Structure.structureIdSetValue",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Structs-Structure.html#v:structureIdSetValue"
        }


#endif

-- method Structure::id_take_value
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "field"
--           , argType = TBasicType TUInt32
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GQuark representing a field"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new value of the field"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_id_take_value" gst_structure_id_take_value :: 
    Ptr Structure ->                        -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    Word32 ->                               -- field : TBasicType TUInt32
    Ptr GValue ->                           -- value : TGValue
    IO ()

-- | Sets the field with the given GQuark /@field@/ to /@value@/.  If the field
-- does not exist, it is created.  If the field exists, the previous
-- value is replaced and freed.
structureIdTakeValue ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Structure
    -- ^ /@structure@/: a t'GI.Gst.Structs.Structure.Structure'
    -> Word32
    -- ^ /@field@/: a @/GQuark/@ representing a field
    -> GValue
    -- ^ /@value@/: the new value of the field
    -> m ()
structureIdTakeValue :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> Word32 -> GValue -> m ()
structureIdTakeValue Structure
structure Word32
field GValue
value = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
structure
    Ptr GValue
value' <- GValue -> IO (Ptr GValue)
B.GValue.disownGValue GValue
value
    Ptr Structure -> Word32 -> Ptr GValue -> IO ()
gst_structure_id_take_value Ptr Structure
structure' Word32
field Ptr GValue
value'
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
value
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data StructureIdTakeValueMethodInfo
instance (signature ~ (Word32 -> GValue -> m ()), MonadIO m) => O.OverloadedMethod StructureIdTakeValueMethodInfo Structure signature where
    overloadedMethod = structureIdTakeValue

instance O.OverloadedMethodInfo StructureIdTakeValueMethodInfo Structure where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Structs.Structure.structureIdTakeValue",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Structs-Structure.html#v:structureIdTakeValue"
        }


#endif

-- method Structure::intersect
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "struct1"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "struct2"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Structure" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_intersect" gst_structure_intersect :: 
    Ptr Structure ->                        -- struct1 : TInterface (Name {namespace = "Gst", name = "Structure"})
    Ptr Structure ->                        -- struct2 : TInterface (Name {namespace = "Gst", name = "Structure"})
    IO (Ptr Structure)

-- | Intersects /@struct1@/ and /@struct2@/ and returns the intersection.
structureIntersect ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Structure
    -- ^ /@struct1@/: a t'GI.Gst.Structs.Structure.Structure'
    -> Structure
    -- ^ /@struct2@/: a t'GI.Gst.Structs.Structure.Structure'
    -> m (Maybe Structure)
    -- ^ __Returns:__ Intersection of /@struct1@/ and /@struct2@/
structureIntersect :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> Structure -> m (Maybe Structure)
structureIntersect Structure
struct1 Structure
struct2 = IO (Maybe Structure) -> m (Maybe Structure)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Structure) -> m (Maybe Structure))
-> IO (Maybe Structure) -> m (Maybe Structure)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
struct1' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
struct1
    Ptr Structure
struct2' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
struct2
    Ptr Structure
result <- Ptr Structure -> Ptr Structure -> IO (Ptr Structure)
gst_structure_intersect Ptr Structure
struct1' Ptr Structure
struct2'
    Maybe Structure
maybeResult <- Ptr Structure
-> (Ptr Structure -> IO Structure) -> IO (Maybe Structure)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Structure
result ((Ptr Structure -> IO Structure) -> IO (Maybe Structure))
-> (Ptr Structure -> IO Structure) -> IO (Maybe Structure)
forall a b. (a -> b) -> a -> b
$ \Ptr Structure
result' -> do
        Structure
result'' <- ((ManagedPtr Structure -> Structure)
-> Ptr Structure -> IO Structure
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Structure -> Structure
Structure) Ptr Structure
result'
        Structure -> IO Structure
forall (m :: * -> *) a. Monad m => a -> m a
return Structure
result''
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
struct1
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
struct2
    Maybe Structure -> IO (Maybe Structure)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Structure
maybeResult

#if defined(ENABLE_OVERLOADING)
data StructureIntersectMethodInfo
instance (signature ~ (Structure -> m (Maybe Structure)), MonadIO m) => O.OverloadedMethod StructureIntersectMethodInfo Structure signature where
    overloadedMethod = structureIntersect

instance O.OverloadedMethodInfo StructureIntersectMethodInfo Structure where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Structs.Structure.structureIntersect",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Structs-Structure.html#v:structureIntersect"
        }


#endif

-- method Structure::is_equal
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "structure1"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "structure2"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_is_equal" gst_structure_is_equal :: 
    Ptr Structure ->                        -- structure1 : TInterface (Name {namespace = "Gst", name = "Structure"})
    Ptr Structure ->                        -- structure2 : TInterface (Name {namespace = "Gst", name = "Structure"})
    IO CInt

-- | Tests if the two t'GI.Gst.Structs.Structure.Structure' are equal.
structureIsEqual ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Structure
    -- ^ /@structure1@/: a t'GI.Gst.Structs.Structure.Structure'.
    -> Structure
    -- ^ /@structure2@/: a t'GI.Gst.Structs.Structure.Structure'.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the two structures have the same name and field.
structureIsEqual :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> Structure -> m Bool
structureIsEqual Structure
structure1 Structure
structure2 = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
structure1' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
structure1
    Ptr Structure
structure2' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
structure2
    CInt
result <- Ptr Structure -> Ptr Structure -> IO CInt
gst_structure_is_equal Ptr Structure
structure1' Ptr Structure
structure2'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure1
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure2
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data StructureIsEqualMethodInfo
instance (signature ~ (Structure -> m Bool), MonadIO m) => O.OverloadedMethod StructureIsEqualMethodInfo Structure signature where
    overloadedMethod = structureIsEqual

instance O.OverloadedMethodInfo StructureIsEqualMethodInfo Structure where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Structs.Structure.structureIsEqual",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Structs-Structure.html#v:structureIsEqual"
        }


#endif

-- method Structure::is_subset
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "subset"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "superset"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a potentially greater #GstStructure"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_is_subset" gst_structure_is_subset :: 
    Ptr Structure ->                        -- subset : TInterface (Name {namespace = "Gst", name = "Structure"})
    Ptr Structure ->                        -- superset : TInterface (Name {namespace = "Gst", name = "Structure"})
    IO CInt

-- | Checks if /@subset@/ is a subset of /@superset@/, i.e. has the same
-- structure name and for all fields that are existing in /@superset@/,
-- /@subset@/ has a value that is a subset of the value in /@superset@/.
structureIsSubset ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Structure
    -- ^ /@subset@/: a t'GI.Gst.Structs.Structure.Structure'
    -> Structure
    -- ^ /@superset@/: a potentially greater t'GI.Gst.Structs.Structure.Structure'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@subset@/ is a subset of /@superset@/
structureIsSubset :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> Structure -> m Bool
structureIsSubset Structure
subset Structure
superset = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
subset' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
subset
    Ptr Structure
superset' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
superset
    CInt
result <- Ptr Structure -> Ptr Structure -> IO CInt
gst_structure_is_subset Ptr Structure
subset' Ptr Structure
superset'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
subset
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
superset
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data StructureIsSubsetMethodInfo
instance (signature ~ (Structure -> m Bool), MonadIO m) => O.OverloadedMethod StructureIsSubsetMethodInfo Structure signature where
    overloadedMethod = structureIsSubset

instance O.OverloadedMethodInfo StructureIsSubsetMethodInfo Structure where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Structs.Structure.structureIsSubset",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Structs-Structure.html#v:structureIsSubset"
        }


#endif

-- method Structure::map_in_place
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "func"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "StructureMapFunc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a function to call for each field"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeCall
--           , argClosure = 2
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "private data" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_map_in_place" gst_structure_map_in_place :: 
    Ptr Structure ->                        -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    FunPtr Gst.Callbacks.C_StructureMapFunc -> -- func : TInterface (Name {namespace = "Gst", name = "StructureMapFunc"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO CInt

-- | Calls the provided function once for each field in the t'GI.Gst.Structs.Structure.Structure'. In
-- contrast to 'GI.Gst.Structs.Structure.structureForeach', the function may modify but not delete the
-- fields. The structure must be mutable.
structureMapInPlace ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Structure
    -- ^ /@structure@/: a t'GI.Gst.Structs.Structure.Structure'
    -> Gst.Callbacks.StructureMapFunc
    -- ^ /@func@/: a function to call for each field
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the supplied function returns 'P.True' For each of the fields,
    -- 'P.False' otherwise.
structureMapInPlace :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> StructureFilterMapFunc -> m Bool
structureMapInPlace Structure
structure StructureFilterMapFunc
func = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
structure
    FunPtr C_StructureFilterMapFunc
func' <- C_StructureFilterMapFunc -> IO (FunPtr C_StructureFilterMapFunc)
Gst.Callbacks.mk_StructureMapFunc (Maybe (Ptr (FunPtr C_StructureFilterMapFunc))
-> StructureFilterMapFunc_WithClosures -> C_StructureFilterMapFunc
Gst.Callbacks.wrap_StructureMapFunc Maybe (Ptr (FunPtr C_StructureFilterMapFunc))
forall a. Maybe a
Nothing (StructureFilterMapFunc -> StructureFilterMapFunc_WithClosures
Gst.Callbacks.drop_closures_StructureMapFunc StructureFilterMapFunc
func))
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    CInt
result <- Ptr Structure
-> FunPtr C_StructureFilterMapFunc -> Ptr () -> IO CInt
gst_structure_map_in_place Ptr Structure
structure' FunPtr C_StructureFilterMapFunc
func' Ptr ()
forall a. Ptr a
userData
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_StructureFilterMapFunc -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_StructureFilterMapFunc
func'
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data StructureMapInPlaceMethodInfo
instance (signature ~ (Gst.Callbacks.StructureMapFunc -> m Bool), MonadIO m) => O.OverloadedMethod StructureMapInPlaceMethodInfo Structure signature where
    overloadedMethod = structureMapInPlace

instance O.OverloadedMethodInfo StructureMapInPlaceMethodInfo Structure where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Structs.Structure.structureMapInPlace",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Structs-Structure.html#v:structureMapInPlace"
        }


#endif

-- method Structure::n_fields
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_n_fields" gst_structure_n_fields :: 
    Ptr Structure ->                        -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    IO Int32

-- | Get the number of fields in the structure.
structureNFields ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Structure
    -- ^ /@structure@/: a t'GI.Gst.Structs.Structure.Structure'
    -> m Int32
    -- ^ __Returns:__ the number of fields in the structure
structureNFields :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> m Int32
structureNFields Structure
structure = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
structure
    Int32
result <- Ptr Structure -> IO Int32
gst_structure_n_fields Ptr Structure
structure'
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data StructureNFieldsMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.OverloadedMethod StructureNFieldsMethodInfo Structure signature where
    overloadedMethod = structureNFields

instance O.OverloadedMethodInfo StructureNFieldsMethodInfo Structure where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Structs.Structure.structureNFields",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Structs-Structure.html#v:structureNFields"
        }


#endif

-- method Structure::nth_field_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the index to get the name of"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_nth_field_name" gst_structure_nth_field_name :: 
    Ptr Structure ->                        -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    Word32 ->                               -- index : TBasicType TUInt
    IO CString

-- | Get the name of the given field number, counting from 0 onwards.
structureNthFieldName ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Structure
    -- ^ /@structure@/: a t'GI.Gst.Structs.Structure.Structure'
    -> Word32
    -- ^ /@index@/: the index to get the name of
    -> m T.Text
    -- ^ __Returns:__ the name of the given field number
structureNthFieldName :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> Word32 -> m Text
structureNthFieldName Structure
structure Word32
index = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
structure
    CString
result <- Ptr Structure -> Word32 -> IO CString
gst_structure_nth_field_name Ptr Structure
structure' Word32
index
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"structureNthFieldName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data StructureNthFieldNameMethodInfo
instance (signature ~ (Word32 -> m T.Text), MonadIO m) => O.OverloadedMethod StructureNthFieldNameMethodInfo Structure signature where
    overloadedMethod = structureNthFieldName

instance O.OverloadedMethodInfo StructureNthFieldNameMethodInfo Structure where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Structs.Structure.structureNthFieldName",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Structs-Structure.html#v:structureNthFieldName"
        }


#endif

-- method Structure::remove_all_fields
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_remove_all_fields" gst_structure_remove_all_fields :: 
    Ptr Structure ->                        -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    IO ()

-- | Removes all fields in a GstStructure.
structureRemoveAllFields ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Structure
    -- ^ /@structure@/: a t'GI.Gst.Structs.Structure.Structure'
    -> m ()
structureRemoveAllFields :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> m ()
structureRemoveAllFields Structure
structure = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
structure
    Ptr Structure -> IO ()
gst_structure_remove_all_fields Ptr Structure
structure'
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data StructureRemoveAllFieldsMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod StructureRemoveAllFieldsMethodInfo Structure signature where
    overloadedMethod = structureRemoveAllFields

instance O.OverloadedMethodInfo StructureRemoveAllFieldsMethodInfo Structure where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Structs.Structure.structureRemoveAllFields",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Structs-Structure.html#v:structureRemoveAllFields"
        }


#endif

-- method Structure::remove_field
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fieldname"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the field to remove"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_remove_field" gst_structure_remove_field :: 
    Ptr Structure ->                        -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    CString ->                              -- fieldname : TBasicType TUTF8
    IO ()

-- | Removes the field with the given name.  If the field with the given
-- name does not exist, the structure is unchanged.
structureRemoveField ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Structure
    -- ^ /@structure@/: a t'GI.Gst.Structs.Structure.Structure'
    -> T.Text
    -- ^ /@fieldname@/: the name of the field to remove
    -> m ()
structureRemoveField :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> Text -> m ()
structureRemoveField Structure
structure Text
fieldname = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
structure
    CString
fieldname' <- Text -> IO CString
textToCString Text
fieldname
    Ptr Structure -> CString -> IO ()
gst_structure_remove_field Ptr Structure
structure' CString
fieldname'
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
fieldname'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data StructureRemoveFieldMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m) => O.OverloadedMethod StructureRemoveFieldMethodInfo Structure signature where
    overloadedMethod = structureRemoveField

instance O.OverloadedMethodInfo StructureRemoveFieldMethodInfo Structure where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Structs.Structure.structureRemoveField",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Structs-Structure.html#v:structureRemoveField"
        }


#endif

-- method Structure::set_array
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fieldname"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of a field"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "array"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "ValueArray" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a pointer to a #GValueArray"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_set_array" gst_structure_set_array :: 
    Ptr Structure ->                        -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    CString ->                              -- fieldname : TBasicType TUTF8
    Ptr GObject.ValueArray.ValueArray ->    -- array : TInterface (Name {namespace = "GObject", name = "ValueArray"})
    IO ()

-- | This is useful in language bindings where unknown GValue types are not
-- supported. This function will convert a /@array@/ to @/GST_TYPE_ARRAY/@ and set
-- the field specified by /@fieldname@/.  Be aware that this is slower then using
-- @/GST_TYPE_ARRAY/@ in a t'GI.GObject.Structs.Value.Value' directly.
-- 
-- /Since: 1.12/
structureSetArray ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Structure
    -- ^ /@structure@/: a t'GI.Gst.Structs.Structure.Structure'
    -> T.Text
    -- ^ /@fieldname@/: the name of a field
    -> GObject.ValueArray.ValueArray
    -- ^ /@array@/: a pointer to a t'GI.GObject.Structs.ValueArray.ValueArray'
    -> m ()
structureSetArray :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> Text -> ValueArray -> m ()
structureSetArray Structure
structure Text
fieldname ValueArray
array = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
structure
    CString
fieldname' <- Text -> IO CString
textToCString Text
fieldname
    Ptr ValueArray
array' <- ValueArray -> IO (Ptr ValueArray)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ValueArray
array
    Ptr Structure -> CString -> Ptr ValueArray -> IO ()
gst_structure_set_array Ptr Structure
structure' CString
fieldname' Ptr ValueArray
array'
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    ValueArray -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ValueArray
array
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
fieldname'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data StructureSetArrayMethodInfo
instance (signature ~ (T.Text -> GObject.ValueArray.ValueArray -> m ()), MonadIO m) => O.OverloadedMethod StructureSetArrayMethodInfo Structure signature where
    overloadedMethod = structureSetArray

instance O.OverloadedMethodInfo StructureSetArrayMethodInfo Structure where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Structs.Structure.structureSetArray",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Structs-Structure.html#v:structureSetArray"
        }


#endif

-- method Structure::set_list
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fieldname"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of a field"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "array"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "ValueArray" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a pointer to a #GValueArray"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_set_list" gst_structure_set_list :: 
    Ptr Structure ->                        -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    CString ->                              -- fieldname : TBasicType TUTF8
    Ptr GObject.ValueArray.ValueArray ->    -- array : TInterface (Name {namespace = "GObject", name = "ValueArray"})
    IO ()

-- | This is useful in language bindings where unknown GValue types are not
-- supported. This function will convert a /@array@/ to @/GST_TYPE_LIST/@ and set
-- the field specified by /@fieldname@/. Be aware that this is slower then using
-- @/GST_TYPE_LIST/@ in a t'GI.GObject.Structs.Value.Value' directly.
-- 
-- /Since: 1.12/
structureSetList ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Structure
    -- ^ /@structure@/: a t'GI.Gst.Structs.Structure.Structure'
    -> T.Text
    -- ^ /@fieldname@/: the name of a field
    -> GObject.ValueArray.ValueArray
    -- ^ /@array@/: a pointer to a t'GI.GObject.Structs.ValueArray.ValueArray'
    -> m ()
structureSetList :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> Text -> ValueArray -> m ()
structureSetList Structure
structure Text
fieldname ValueArray
array = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
structure
    CString
fieldname' <- Text -> IO CString
textToCString Text
fieldname
    Ptr ValueArray
array' <- ValueArray -> IO (Ptr ValueArray)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ValueArray
array
    Ptr Structure -> CString -> Ptr ValueArray -> IO ()
gst_structure_set_list Ptr Structure
structure' CString
fieldname' Ptr ValueArray
array'
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    ValueArray -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ValueArray
array
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
fieldname'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data StructureSetListMethodInfo
instance (signature ~ (T.Text -> GObject.ValueArray.ValueArray -> m ()), MonadIO m) => O.OverloadedMethod StructureSetListMethodInfo Structure signature where
    overloadedMethod = structureSetList

instance O.OverloadedMethodInfo StructureSetListMethodInfo Structure where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Structs.Structure.structureSetList",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Structs-Structure.html#v:structureSetList"
        }


#endif

-- method Structure::set_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new name of the structure"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_set_name" gst_structure_set_name :: 
    Ptr Structure ->                        -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    CString ->                              -- name : TBasicType TUTF8
    IO ()

-- | Sets the name of the structure to the given /@name@/.  The string
-- provided is copied before being used. It must not be empty, start with a
-- letter and can be followed by letters, numbers and any of \"\/-_.:\".
structureSetName ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Structure
    -- ^ /@structure@/: a t'GI.Gst.Structs.Structure.Structure'
    -> T.Text
    -- ^ /@name@/: the new name of the structure
    -> m ()
structureSetName :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> Text -> m ()
structureSetName Structure
structure Text
name = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
structure
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr Structure -> CString -> IO ()
gst_structure_set_name Ptr Structure
structure' CString
name'
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data StructureSetNameMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m) => O.OverloadedMethod StructureSetNameMethodInfo Structure signature where
    overloadedMethod = structureSetName

instance O.OverloadedMethodInfo StructureSetNameMethodInfo Structure where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Structs.Structure.structureSetName",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Structs-Structure.html#v:structureSetName"
        }


#endif

-- method Structure::set_parent_refcount
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "refcount"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a pointer to the parent's refcount"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_set_parent_refcount" gst_structure_set_parent_refcount :: 
    Ptr Structure ->                        -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    Int32 ->                                -- refcount : TBasicType TInt
    IO CInt

-- | Sets the parent_refcount field of t'GI.Gst.Structs.Structure.Structure'. This field is used to
-- determine whether a structure is mutable or not. This function should only be
-- called by code implementing parent objects of t'GI.Gst.Structs.Structure.Structure', as described in
-- the MT Refcounting section of the design documents.
structureSetParentRefcount ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Structure
    -- ^ /@structure@/: a t'GI.Gst.Structs.Structure.Structure'
    -> Int32
    -- ^ /@refcount@/: a pointer to the parent\'s refcount
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the parent refcount could be set.
structureSetParentRefcount :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> Int32 -> m Bool
structureSetParentRefcount Structure
structure Int32
refcount = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
structure
    CInt
result <- Ptr Structure -> Int32 -> IO CInt
gst_structure_set_parent_refcount Ptr Structure
structure' Int32
refcount
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data StructureSetParentRefcountMethodInfo
instance (signature ~ (Int32 -> m Bool), MonadIO m) => O.OverloadedMethod StructureSetParentRefcountMethodInfo Structure signature where
    overloadedMethod = structureSetParentRefcount

instance O.OverloadedMethodInfo StructureSetParentRefcountMethodInfo Structure where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Structs.Structure.structureSetParentRefcount",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Structs-Structure.html#v:structureSetParentRefcount"
        }


#endif

-- method Structure::set_value
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fieldname"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the field to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new value of the field"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_set_value" gst_structure_set_value :: 
    Ptr Structure ->                        -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    CString ->                              -- fieldname : TBasicType TUTF8
    Ptr GValue ->                           -- value : TGValue
    IO ()

-- | Sets the field with the given name /@field@/ to /@value@/.  If the field
-- does not exist, it is created.  If the field exists, the previous
-- value is replaced and freed.
structureSetValue ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Structure
    -- ^ /@structure@/: a t'GI.Gst.Structs.Structure.Structure'
    -> T.Text
    -- ^ /@fieldname@/: the name of the field to set
    -> GValue
    -- ^ /@value@/: the new value of the field
    -> m ()
structureSetValue :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> Text -> GValue -> m ()
structureSetValue Structure
structure Text
fieldname GValue
value = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
structure
    CString
fieldname' <- Text -> IO CString
textToCString Text
fieldname
    Ptr GValue
value' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
value
    Ptr Structure -> CString -> Ptr GValue -> IO ()
gst_structure_set_value Ptr Structure
structure' CString
fieldname' Ptr GValue
value'
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
value
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
fieldname'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data StructureSetValueMethodInfo
instance (signature ~ (T.Text -> GValue -> m ()), MonadIO m) => O.OverloadedMethod StructureSetValueMethodInfo Structure signature where
    overloadedMethod = structureSetValue

instance O.OverloadedMethodInfo StructureSetValueMethodInfo Structure where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Structs.Structure.structureSetValue",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Structs-Structure.html#v:structureSetValue"
        }


#endif

-- method Structure::take_value
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fieldname"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the field to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new value of the field"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_take_value" gst_structure_take_value :: 
    Ptr Structure ->                        -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    CString ->                              -- fieldname : TBasicType TUTF8
    Ptr GValue ->                           -- value : TGValue
    IO ()

-- | Sets the field with the given name /@field@/ to /@value@/.  If the field
-- does not exist, it is created.  If the field exists, the previous
-- value is replaced and freed. The function will take ownership of /@value@/.
structureTakeValue ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Structure
    -- ^ /@structure@/: a t'GI.Gst.Structs.Structure.Structure'
    -> T.Text
    -- ^ /@fieldname@/: the name of the field to set
    -> GValue
    -- ^ /@value@/: the new value of the field
    -> m ()
structureTakeValue :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> Text -> GValue -> m ()
structureTakeValue Structure
structure Text
fieldname GValue
value = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
structure
    CString
fieldname' <- Text -> IO CString
textToCString Text
fieldname
    Ptr GValue
value' <- GValue -> IO (Ptr GValue)
B.GValue.disownGValue GValue
value
    Ptr Structure -> CString -> Ptr GValue -> IO ()
gst_structure_take_value Ptr Structure
structure' CString
fieldname' Ptr GValue
value'
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
value
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
fieldname'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data StructureTakeValueMethodInfo
instance (signature ~ (T.Text -> GValue -> m ()), MonadIO m) => O.OverloadedMethod StructureTakeValueMethodInfo Structure signature where
    overloadedMethod = structureTakeValue

instance O.OverloadedMethodInfo StructureTakeValueMethodInfo Structure where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Structs.Structure.structureTakeValue",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Structs-Structure.html#v:structureTakeValue"
        }


#endif

-- method Structure::to_string
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "gst_structure_to_string" gst_structure_to_string :: 
    Ptr Structure ->                        -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    IO CString

-- | Converts /@structure@/ to a human-readable string representation.
-- 
-- For debugging purposes its easier to do something like this:
-- 
-- === /C code/
-- >
-- >GST_LOG ("structure is %" GST_PTR_FORMAT, structure);
-- 
-- This prints the structure in human readable form.
-- 
-- The current implementation of serialization will lead to unexpected results
-- when there are nested t'GI.Gst.Structs.Caps.Caps' \/ t'GI.Gst.Structs.Structure.Structure' deeper than one level.
-- 
-- Free-function: g_free
structureToString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Structure
    -- ^ /@structure@/: a t'GI.Gst.Structs.Structure.Structure'
    -> m T.Text
    -- ^ __Returns:__ a pointer to string allocated by 'GI.GLib.Functions.malloc'.
    --     'GI.GLib.Functions.free' after usage.
structureToString :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> m Text
structureToString Structure
structure = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
structure
    CString
result <- Ptr Structure -> IO CString
gst_structure_to_string Ptr Structure
structure'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"structureToString" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data StructureToStringMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod StructureToStringMethodInfo Structure signature where
    overloadedMethod = structureToString

instance O.OverloadedMethodInfo StructureToStringMethodInfo Structure where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Structs.Structure.structureToString",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Structs-Structure.html#v:structureToString"
        }


#endif

-- XXX Could not generate method Structure::take
-- Not implemented: Nullable inout structs not supported
#if defined(ENABLE_OVERLOADING)
type family ResolveStructureMethod (t :: Symbol) (o :: *) :: * where
    ResolveStructureMethod "canIntersect" o = StructureCanIntersectMethodInfo
    ResolveStructureMethod "copy" o = StructureCopyMethodInfo
    ResolveStructureMethod "filterAndMapInPlace" o = StructureFilterAndMapInPlaceMethodInfo
    ResolveStructureMethod "fixate" o = StructureFixateMethodInfo
    ResolveStructureMethod "fixateField" o = StructureFixateFieldMethodInfo
    ResolveStructureMethod "fixateFieldBoolean" o = StructureFixateFieldBooleanMethodInfo
    ResolveStructureMethod "fixateFieldNearestDouble" o = StructureFixateFieldNearestDoubleMethodInfo
    ResolveStructureMethod "fixateFieldNearestFraction" o = StructureFixateFieldNearestFractionMethodInfo
    ResolveStructureMethod "fixateFieldNearestInt" o = StructureFixateFieldNearestIntMethodInfo
    ResolveStructureMethod "fixateFieldString" o = StructureFixateFieldStringMethodInfo
    ResolveStructureMethod "foreach" o = StructureForeachMethodInfo
    ResolveStructureMethod "free" o = StructureFreeMethodInfo
    ResolveStructureMethod "hasField" o = StructureHasFieldMethodInfo
    ResolveStructureMethod "hasFieldTyped" o = StructureHasFieldTypedMethodInfo
    ResolveStructureMethod "hasName" o = StructureHasNameMethodInfo
    ResolveStructureMethod "idGetValue" o = StructureIdGetValueMethodInfo
    ResolveStructureMethod "idHasField" o = StructureIdHasFieldMethodInfo
    ResolveStructureMethod "idHasFieldTyped" o = StructureIdHasFieldTypedMethodInfo
    ResolveStructureMethod "idSetValue" o = StructureIdSetValueMethodInfo
    ResolveStructureMethod "idTakeValue" o = StructureIdTakeValueMethodInfo
    ResolveStructureMethod "intersect" o = StructureIntersectMethodInfo
    ResolveStructureMethod "isEqual" o = StructureIsEqualMethodInfo
    ResolveStructureMethod "isSubset" o = StructureIsSubsetMethodInfo
    ResolveStructureMethod "mapInPlace" o = StructureMapInPlaceMethodInfo
    ResolveStructureMethod "nFields" o = StructureNFieldsMethodInfo
    ResolveStructureMethod "nthFieldName" o = StructureNthFieldNameMethodInfo
    ResolveStructureMethod "removeAllFields" o = StructureRemoveAllFieldsMethodInfo
    ResolveStructureMethod "removeField" o = StructureRemoveFieldMethodInfo
    ResolveStructureMethod "takeValue" o = StructureTakeValueMethodInfo
    ResolveStructureMethod "toString" o = StructureToStringMethodInfo
    ResolveStructureMethod "getArray" o = StructureGetArrayMethodInfo
    ResolveStructureMethod "getBoolean" o = StructureGetBooleanMethodInfo
    ResolveStructureMethod "getClockTime" o = StructureGetClockTimeMethodInfo
    ResolveStructureMethod "getDate" o = StructureGetDateMethodInfo
    ResolveStructureMethod "getDateTime" o = StructureGetDateTimeMethodInfo
    ResolveStructureMethod "getDouble" o = StructureGetDoubleMethodInfo
    ResolveStructureMethod "getEnum" o = StructureGetEnumMethodInfo
    ResolveStructureMethod "getFieldType" o = StructureGetFieldTypeMethodInfo
    ResolveStructureMethod "getFlagset" o = StructureGetFlagsetMethodInfo
    ResolveStructureMethod "getFraction" o = StructureGetFractionMethodInfo
    ResolveStructureMethod "getInt" o = StructureGetIntMethodInfo
    ResolveStructureMethod "getInt64" o = StructureGetInt64MethodInfo
    ResolveStructureMethod "getList" o = StructureGetListMethodInfo
    ResolveStructureMethod "getName" o = StructureGetNameMethodInfo
    ResolveStructureMethod "getNameId" o = StructureGetNameIdMethodInfo
    ResolveStructureMethod "getString" o = StructureGetStringMethodInfo
    ResolveStructureMethod "getUint" o = StructureGetUintMethodInfo
    ResolveStructureMethod "getUint64" o = StructureGetUint64MethodInfo
    ResolveStructureMethod "getValue" o = StructureGetValueMethodInfo
    ResolveStructureMethod "setArray" o = StructureSetArrayMethodInfo
    ResolveStructureMethod "setList" o = StructureSetListMethodInfo
    ResolveStructureMethod "setName" o = StructureSetNameMethodInfo
    ResolveStructureMethod "setParentRefcount" o = StructureSetParentRefcountMethodInfo
    ResolveStructureMethod "setValue" o = StructureSetValueMethodInfo
    ResolveStructureMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveStructureMethod t Structure, O.OverloadedMethod info Structure p) => OL.IsLabel t (Structure -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveStructureMethod t Structure, O.OverloadedMethod info Structure p, R.HasField t Structure p) => R.HasField t Structure p where
    getField = O.overloadedMethod @info

#endif

instance (info ~ ResolveStructureMethod t Structure, O.OverloadedMethodInfo info Structure) => OL.IsLabel t (O.MethodProxy info Structure) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif

#endif