{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A GstIterator is used to retrieve multiple objects from another object in
-- a threadsafe way.
-- 
-- Various GStreamer objects provide access to their internal structures using
-- an iterator.
-- 
-- Note that if calling a GstIterator function results in your code receiving
-- a refcounted object (with, say, 'GI.GObject.Structs.Value.valueGetObject'), the refcount for that
-- object will not be increased. Your code is responsible for taking a reference
-- if it wants to continue using it later.
-- 
-- The basic use pattern of an iterator is as follows:
-- 
-- === /C code/
-- >
-- >  GstIterator *it = _get_iterator(object);
-- >  GValue item = G_VALUE_INIT;
-- >  done = FALSE;
-- >  while (!done) {
-- >    switch (gst_iterator_next (it, &item)) {
-- >      case GST_ITERATOR_OK:
-- >        ...get/use/change item here...
-- >        g_value_reset (&item);
-- >        break;
-- >      case GST_ITERATOR_RESYNC:
-- >        ...rollback changes to items...
-- >        gst_iterator_resync (it);
-- >        break;
-- >      case GST_ITERATOR_ERROR:
-- >        ...wrong parameters were given...
-- >        done = TRUE;
-- >        break;
-- >      case GST_ITERATOR_DONE:
-- >        done = TRUE;
-- >        break;
-- >    }
-- >  }
-- >  g_value_unset (&item);
-- >  gst_iterator_free (it);
-- 

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

module GI.Gst.Structs.Iterator
    ( 

-- * Exported types
    Iterator(..)                            ,
    newZeroIterator                         ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [copy]("GI.Gst.Structs.Iterator#g:method:copy"), [filter]("GI.Gst.Structs.Iterator#g:method:filter"), [findCustom]("GI.Gst.Structs.Iterator#g:method:findCustom"), [fold]("GI.Gst.Structs.Iterator#g:method:fold"), [foreach]("GI.Gst.Structs.Iterator#g:method:foreach"), [free]("GI.Gst.Structs.Iterator#g:method:free"), [next]("GI.Gst.Structs.Iterator#g:method:next"), [push]("GI.Gst.Structs.Iterator#g:method:push"), [resync]("GI.Gst.Structs.Iterator#g:method:resync").
-- 
-- ==== Getters
-- /None/.
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveIteratorMethod                   ,
#endif

-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    IteratorCopyMethodInfo                  ,
#endif
    iteratorCopy                            ,


-- ** filter #method:filter#

#if defined(ENABLE_OVERLOADING)
    IteratorFilterMethodInfo                ,
#endif
    iteratorFilter                          ,


-- ** findCustom #method:findCustom#

#if defined(ENABLE_OVERLOADING)
    IteratorFindCustomMethodInfo            ,
#endif
    iteratorFindCustom                      ,


-- ** fold #method:fold#

#if defined(ENABLE_OVERLOADING)
    IteratorFoldMethodInfo                  ,
#endif
    iteratorFold                            ,


-- ** foreach #method:foreach#

#if defined(ENABLE_OVERLOADING)
    IteratorForeachMethodInfo               ,
#endif
    iteratorForeach                         ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    IteratorFreeMethodInfo                  ,
#endif
    iteratorFree                            ,


-- ** newSingle #method:newSingle#

    iteratorNewSingle                       ,


-- ** next #method:next#

#if defined(ENABLE_OVERLOADING)
    IteratorNextMethodInfo                  ,
#endif
    iteratorNext                            ,


-- ** push #method:push#

#if defined(ENABLE_OVERLOADING)
    IteratorPushMethodInfo                  ,
#endif
    iteratorPush                            ,


-- ** resync #method:resync#

#if defined(ENABLE_OVERLOADING)
    IteratorResyncMethodInfo                ,
#endif
    iteratorResync                          ,




 -- * Properties


-- ** cookie #attr:cookie#
-- | The cookie; the value of the master_cookie when this iterator was
--          created.

    getIteratorCookie                       ,
#if defined(ENABLE_OVERLOADING)
    iterator_cookie                         ,
#endif
    setIteratorCookie                       ,


-- ** copy #attr:copy#
-- | The function to copy the iterator

    clearIteratorCopy                       ,
    getIteratorCopy                         ,
#if defined(ENABLE_OVERLOADING)
    iterator_copy                           ,
#endif
    setIteratorCopy                         ,


-- ** free #attr:free#
-- | The function to call when the iterator is freed

    clearIteratorFree                       ,
    getIteratorFree                         ,
#if defined(ENABLE_OVERLOADING)
    iterator_free                           ,
#endif
    setIteratorFree                         ,


-- ** item #attr:item#
-- | The function to be called for each item retrieved

    clearIteratorItem                       ,
    getIteratorItem                         ,
#if defined(ENABLE_OVERLOADING)
    iterator_item                           ,
#endif
    setIteratorItem                         ,


-- ** lock #attr:lock#
-- | The lock protecting the data structure and the cookie.

    clearIteratorLock                       ,
    getIteratorLock                         ,
#if defined(ENABLE_OVERLOADING)
    iterator_lock                           ,
#endif
    setIteratorLock                         ,


-- ** masterCookie #attr:masterCookie#
-- | A pointer to the master cookie.

    getIteratorMasterCookie                 ,
#if defined(ENABLE_OVERLOADING)
    iterator_masterCookie                   ,
#endif
    setIteratorMasterCookie                 ,


-- ** next #attr:next#
-- | The function to get the next item in the iterator

    clearIteratorNext                       ,
    getIteratorNext                         ,
#if defined(ENABLE_OVERLOADING)
    iterator_next                           ,
#endif
    setIteratorNext                         ,


-- ** pushed #attr:pushed#
-- | The iterator that is currently pushed with 'GI.Gst.Structs.Iterator.iteratorPush'

    clearIteratorPushed                     ,
    getIteratorPushed                       ,
#if defined(ENABLE_OVERLOADING)
    iterator_pushed                         ,
#endif
    setIteratorPushed                       ,


-- ** resync #attr:resync#
-- | The function to call when a resync is needed.

    clearIteratorResync                     ,
    getIteratorResync                       ,
#if defined(ENABLE_OVERLOADING)
    iterator_resync                         ,
#endif
    setIteratorResync                       ,


-- ** size #attr:size#
-- | the size of the iterator

    getIteratorSize                         ,
#if defined(ENABLE_OVERLOADING)
    iterator_size                           ,
#endif
    setIteratorSize                         ,


-- ** type #attr:type#
-- | The type of the object that this iterator will return

    getIteratorType                         ,
#if defined(ENABLE_OVERLOADING)
    iterator_type                           ,
#endif
    setIteratorType                         ,




    ) 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.GHashTable as B.GHT
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.Coerce as Coerce
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.Callbacks as GLib.Callbacks
import qualified GI.GLib.Unions.Mutex as GLib.Mutex
import qualified GI.Gst.Callbacks as Gst.Callbacks
import {-# SOURCE #-} qualified GI.Gst.Enums as Gst.Enums

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

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

foreign import ccall "gst_iterator_get_type" c_gst_iterator_get_type :: 
    IO GType

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

instance B.Types.TypedObject Iterator where
    glibType :: IO GType
glibType = IO GType
c_gst_iterator_get_type

instance B.Types.GBoxed Iterator

-- | Convert 'Iterator' 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 Iterator) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gst_iterator_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Iterator -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Iterator
P.Nothing = Ptr GValue -> Ptr Iterator -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv (Ptr Iterator
forall a. Ptr a
FP.nullPtr :: FP.Ptr Iterator)
    gvalueSet_ Ptr GValue
gv (P.Just Iterator
obj) = Iterator -> (Ptr Iterator -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Iterator
obj (Ptr GValue -> Ptr Iterator -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Iterator)
gvalueGet_ Ptr GValue
gv = do
        Ptr Iterator
ptr <- Ptr GValue -> IO (Ptr Iterator)
forall b. Ptr GValue -> IO (Ptr b)
B.GValue.get_boxed Ptr GValue
gv :: IO (Ptr Iterator)
        if Ptr Iterator
ptr Ptr Iterator -> Ptr Iterator -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Iterator
forall a. Ptr a
FP.nullPtr
        then Iterator -> Maybe Iterator
forall a. a -> Maybe a
P.Just (Iterator -> Maybe Iterator) -> IO Iterator -> IO (Maybe Iterator)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr Iterator -> Iterator) -> Ptr Iterator -> IO Iterator
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr Iterator -> Iterator
Iterator Ptr Iterator
ptr
        else Maybe Iterator -> IO (Maybe Iterator)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Iterator
forall a. Maybe a
P.Nothing
        
    

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

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


-- | Get the value of the “@copy@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' iterator #copy
-- @
getIteratorCopy :: MonadIO m => Iterator -> m (Maybe Gst.Callbacks.IteratorCopyFunction)
getIteratorCopy :: forall (m :: * -> *).
MonadIO m =>
Iterator -> m (Maybe IteratorCopyFunction)
getIteratorCopy Iterator
s = IO (Maybe IteratorCopyFunction) -> m (Maybe IteratorCopyFunction)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe IteratorCopyFunction) -> m (Maybe IteratorCopyFunction))
-> IO (Maybe IteratorCopyFunction)
-> m (Maybe IteratorCopyFunction)
forall a b. (a -> b) -> a -> b
$ Iterator
-> (Ptr Iterator -> IO (Maybe IteratorCopyFunction))
-> IO (Maybe IteratorCopyFunction)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Iterator
s ((Ptr Iterator -> IO (Maybe IteratorCopyFunction))
 -> IO (Maybe IteratorCopyFunction))
-> (Ptr Iterator -> IO (Maybe IteratorCopyFunction))
-> IO (Maybe IteratorCopyFunction)
forall a b. (a -> b) -> a -> b
$ \Ptr Iterator
ptr -> do
    FunPtr C_IteratorCopyFunction
val <- Ptr (FunPtr C_IteratorCopyFunction)
-> IO (FunPtr C_IteratorCopyFunction)
forall a. Storable a => Ptr a -> IO a
peek (Ptr Iterator
ptr Ptr Iterator -> Int -> Ptr (FunPtr C_IteratorCopyFunction)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) :: IO (FunPtr Gst.Callbacks.C_IteratorCopyFunction)
    Maybe IteratorCopyFunction
result <- FunPtr C_IteratorCopyFunction
-> (FunPtr C_IteratorCopyFunction -> IO IteratorCopyFunction)
-> IO (Maybe IteratorCopyFunction)
forall a b. FunPtr a -> (FunPtr a -> IO b) -> IO (Maybe b)
SP.convertFunPtrIfNonNull FunPtr C_IteratorCopyFunction
val ((FunPtr C_IteratorCopyFunction -> IO IteratorCopyFunction)
 -> IO (Maybe IteratorCopyFunction))
-> (FunPtr C_IteratorCopyFunction -> IO IteratorCopyFunction)
-> IO (Maybe IteratorCopyFunction)
forall a b. (a -> b) -> a -> b
$ \FunPtr C_IteratorCopyFunction
val' -> do
        let val'' :: IteratorCopyFunction
val'' = FunPtr C_IteratorCopyFunction -> IteratorCopyFunction
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FunPtr C_IteratorCopyFunction -> Iterator -> Iterator -> m ()
Gst.Callbacks.dynamic_IteratorCopyFunction FunPtr C_IteratorCopyFunction
val'
        IteratorCopyFunction -> IO IteratorCopyFunction
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IteratorCopyFunction
val''
    Maybe IteratorCopyFunction -> IO (Maybe IteratorCopyFunction)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe IteratorCopyFunction
result

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

-- | Set the value of the “@copy@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #copy
-- @
clearIteratorCopy :: MonadIO m => Iterator -> m ()
clearIteratorCopy :: forall (m :: * -> *). MonadIO m => Iterator -> m ()
clearIteratorCopy Iterator
s = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Iterator -> (Ptr Iterator -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Iterator
s ((Ptr Iterator -> IO ()) -> IO ())
-> (Ptr Iterator -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Iterator
ptr -> do
    Ptr (FunPtr C_IteratorCopyFunction)
-> FunPtr C_IteratorCopyFunction -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Iterator
ptr Ptr Iterator -> Int -> Ptr (FunPtr C_IteratorCopyFunction)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (FunPtr C_IteratorCopyFunction
forall a. FunPtr a
FP.nullFunPtr :: FunPtr Gst.Callbacks.C_IteratorCopyFunction)

#if defined(ENABLE_OVERLOADING)
data IteratorCopyFieldInfo
instance AttrInfo IteratorCopyFieldInfo where
    type AttrBaseTypeConstraint IteratorCopyFieldInfo = (~) Iterator
    type AttrAllowedOps IteratorCopyFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint IteratorCopyFieldInfo = (~) (FunPtr Gst.Callbacks.C_IteratorCopyFunction)
    type AttrTransferTypeConstraint IteratorCopyFieldInfo = (~)Gst.Callbacks.IteratorCopyFunction
    type AttrTransferType IteratorCopyFieldInfo = (FunPtr Gst.Callbacks.C_IteratorCopyFunction)
    type AttrGetType IteratorCopyFieldInfo = Maybe Gst.Callbacks.IteratorCopyFunction
    type AttrLabel IteratorCopyFieldInfo = "copy"
    type AttrOrigin IteratorCopyFieldInfo = Iterator
    attrGet = getIteratorCopy
    attrSet = setIteratorCopy
    attrConstruct = undefined
    attrClear = clearIteratorCopy
    attrTransfer _ v = do
        Gst.Callbacks.mk_IteratorCopyFunction (Gst.Callbacks.wrap_IteratorCopyFunction Nothing v)
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Iterator.copy"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Iterator.html#g:attr:copy"
        })

iterator_copy :: AttrLabelProxy "copy"
iterator_copy = AttrLabelProxy

#endif


-- | Get the value of the “@next@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' iterator #next
-- @
getIteratorNext :: MonadIO m => Iterator -> m (Maybe Gst.Callbacks.IteratorNextFunction)
getIteratorNext :: forall (m :: * -> *).
MonadIO m =>
Iterator -> m (Maybe IteratorNextFunction)
getIteratorNext Iterator
s = IO (Maybe IteratorNextFunction) -> m (Maybe IteratorNextFunction)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe IteratorNextFunction) -> m (Maybe IteratorNextFunction))
-> IO (Maybe IteratorNextFunction)
-> m (Maybe IteratorNextFunction)
forall a b. (a -> b) -> a -> b
$ Iterator
-> (Ptr Iterator -> IO (Maybe IteratorNextFunction))
-> IO (Maybe IteratorNextFunction)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Iterator
s ((Ptr Iterator -> IO (Maybe IteratorNextFunction))
 -> IO (Maybe IteratorNextFunction))
-> (Ptr Iterator -> IO (Maybe IteratorNextFunction))
-> IO (Maybe IteratorNextFunction)
forall a b. (a -> b) -> a -> b
$ \Ptr Iterator
ptr -> do
    FunPtr C_IteratorNextFunction
val <- Ptr (FunPtr C_IteratorNextFunction)
-> IO (FunPtr C_IteratorNextFunction)
forall a. Storable a => Ptr a -> IO a
peek (Ptr Iterator
ptr Ptr Iterator -> Int -> Ptr (FunPtr C_IteratorNextFunction)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) :: IO (FunPtr Gst.Callbacks.C_IteratorNextFunction)
    Maybe IteratorNextFunction
result <- FunPtr C_IteratorNextFunction
-> (FunPtr C_IteratorNextFunction -> IO IteratorNextFunction)
-> IO (Maybe IteratorNextFunction)
forall a b. FunPtr a -> (FunPtr a -> IO b) -> IO (Maybe b)
SP.convertFunPtrIfNonNull FunPtr C_IteratorNextFunction
val ((FunPtr C_IteratorNextFunction -> IO IteratorNextFunction)
 -> IO (Maybe IteratorNextFunction))
-> (FunPtr C_IteratorNextFunction -> IO IteratorNextFunction)
-> IO (Maybe IteratorNextFunction)
forall a b. (a -> b) -> a -> b
$ \FunPtr C_IteratorNextFunction
val' -> do
        let val'' :: IteratorNextFunction
val'' = FunPtr C_IteratorNextFunction -> IteratorNextFunction
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FunPtr C_IteratorNextFunction
-> Iterator -> GValue -> m IteratorResult
Gst.Callbacks.dynamic_IteratorNextFunction FunPtr C_IteratorNextFunction
val'
        IteratorNextFunction -> IO IteratorNextFunction
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IteratorNextFunction
val''
    Maybe IteratorNextFunction -> IO (Maybe IteratorNextFunction)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe IteratorNextFunction
result

-- | Set the value of the “@next@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' iterator [ #next 'Data.GI.Base.Attributes.:=' value ]
-- @
setIteratorNext :: MonadIO m => Iterator -> FunPtr Gst.Callbacks.C_IteratorNextFunction -> m ()
setIteratorNext :: forall (m :: * -> *).
MonadIO m =>
Iterator -> FunPtr C_IteratorNextFunction -> m ()
setIteratorNext Iterator
s FunPtr C_IteratorNextFunction
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Iterator -> (Ptr Iterator -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Iterator
s ((Ptr Iterator -> IO ()) -> IO ())
-> (Ptr Iterator -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Iterator
ptr -> do
    Ptr (FunPtr C_IteratorNextFunction)
-> FunPtr C_IteratorNextFunction -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Iterator
ptr Ptr Iterator -> Int -> Ptr (FunPtr C_IteratorNextFunction)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (FunPtr C_IteratorNextFunction
val :: FunPtr Gst.Callbacks.C_IteratorNextFunction)

-- | Set the value of the “@next@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #next
-- @
clearIteratorNext :: MonadIO m => Iterator -> m ()
clearIteratorNext :: forall (m :: * -> *). MonadIO m => Iterator -> m ()
clearIteratorNext Iterator
s = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Iterator -> (Ptr Iterator -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Iterator
s ((Ptr Iterator -> IO ()) -> IO ())
-> (Ptr Iterator -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Iterator
ptr -> do
    Ptr (FunPtr C_IteratorNextFunction)
-> FunPtr C_IteratorNextFunction -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Iterator
ptr Ptr Iterator -> Int -> Ptr (FunPtr C_IteratorNextFunction)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (FunPtr C_IteratorNextFunction
forall a. FunPtr a
FP.nullFunPtr :: FunPtr Gst.Callbacks.C_IteratorNextFunction)

#if defined(ENABLE_OVERLOADING)
data IteratorNextFieldInfo
instance AttrInfo IteratorNextFieldInfo where
    type AttrBaseTypeConstraint IteratorNextFieldInfo = (~) Iterator
    type AttrAllowedOps IteratorNextFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint IteratorNextFieldInfo = (~) (FunPtr Gst.Callbacks.C_IteratorNextFunction)
    type AttrTransferTypeConstraint IteratorNextFieldInfo = (~)Gst.Callbacks.IteratorNextFunction
    type AttrTransferType IteratorNextFieldInfo = (FunPtr Gst.Callbacks.C_IteratorNextFunction)
    type AttrGetType IteratorNextFieldInfo = Maybe Gst.Callbacks.IteratorNextFunction
    type AttrLabel IteratorNextFieldInfo = "next"
    type AttrOrigin IteratorNextFieldInfo = Iterator
    attrGet = getIteratorNext
    attrSet = setIteratorNext
    attrConstruct = undefined
    attrClear = clearIteratorNext
    attrTransfer _ v = do
        Gst.Callbacks.mk_IteratorNextFunction (Gst.Callbacks.wrap_IteratorNextFunction Nothing v)
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Iterator.next"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Iterator.html#g:attr:next"
        })

iterator_next :: AttrLabelProxy "next"
iterator_next = AttrLabelProxy

#endif


-- | Get the value of the “@item@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' iterator #item
-- @
getIteratorItem :: MonadIO m => Iterator -> m (Maybe Gst.Callbacks.IteratorItemFunction)
getIteratorItem :: forall (m :: * -> *).
MonadIO m =>
Iterator -> m (Maybe IteratorItemFunction)
getIteratorItem Iterator
s = IO (Maybe IteratorItemFunction) -> m (Maybe IteratorItemFunction)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe IteratorItemFunction) -> m (Maybe IteratorItemFunction))
-> IO (Maybe IteratorItemFunction)
-> m (Maybe IteratorItemFunction)
forall a b. (a -> b) -> a -> b
$ Iterator
-> (Ptr Iterator -> IO (Maybe IteratorItemFunction))
-> IO (Maybe IteratorItemFunction)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Iterator
s ((Ptr Iterator -> IO (Maybe IteratorItemFunction))
 -> IO (Maybe IteratorItemFunction))
-> (Ptr Iterator -> IO (Maybe IteratorItemFunction))
-> IO (Maybe IteratorItemFunction)
forall a b. (a -> b) -> a -> b
$ \Ptr Iterator
ptr -> do
    FunPtr C_IteratorNextFunction
val <- Ptr (FunPtr C_IteratorNextFunction)
-> IO (FunPtr C_IteratorNextFunction)
forall a. Storable a => Ptr a -> IO a
peek (Ptr Iterator
ptr Ptr Iterator -> Int -> Ptr (FunPtr C_IteratorNextFunction)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) :: IO (FunPtr Gst.Callbacks.C_IteratorItemFunction)
    Maybe IteratorItemFunction
result <- FunPtr C_IteratorNextFunction
-> (FunPtr C_IteratorNextFunction -> IO IteratorItemFunction)
-> IO (Maybe IteratorItemFunction)
forall a b. FunPtr a -> (FunPtr a -> IO b) -> IO (Maybe b)
SP.convertFunPtrIfNonNull FunPtr C_IteratorNextFunction
val ((FunPtr C_IteratorNextFunction -> IO IteratorItemFunction)
 -> IO (Maybe IteratorItemFunction))
-> (FunPtr C_IteratorNextFunction -> IO IteratorItemFunction)
-> IO (Maybe IteratorItemFunction)
forall a b. (a -> b) -> a -> b
$ \FunPtr C_IteratorNextFunction
val' -> do
        let val'' :: IteratorItemFunction
val'' = FunPtr C_IteratorNextFunction -> IteratorItemFunction
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FunPtr C_IteratorNextFunction
-> Iterator -> GValue -> m IteratorItem
Gst.Callbacks.dynamic_IteratorItemFunction FunPtr C_IteratorNextFunction
val'
        IteratorItemFunction -> IO IteratorItemFunction
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IteratorItemFunction
val''
    Maybe IteratorItemFunction -> IO (Maybe IteratorItemFunction)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe IteratorItemFunction
result

-- | Set the value of the “@item@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' iterator [ #item 'Data.GI.Base.Attributes.:=' value ]
-- @
setIteratorItem :: MonadIO m => Iterator -> FunPtr Gst.Callbacks.C_IteratorItemFunction -> m ()
setIteratorItem :: forall (m :: * -> *).
MonadIO m =>
Iterator -> FunPtr C_IteratorNextFunction -> m ()
setIteratorItem Iterator
s FunPtr C_IteratorNextFunction
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Iterator -> (Ptr Iterator -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Iterator
s ((Ptr Iterator -> IO ()) -> IO ())
-> (Ptr Iterator -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Iterator
ptr -> do
    Ptr (FunPtr C_IteratorNextFunction)
-> FunPtr C_IteratorNextFunction -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Iterator
ptr Ptr Iterator -> Int -> Ptr (FunPtr C_IteratorNextFunction)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) (FunPtr C_IteratorNextFunction
val :: FunPtr Gst.Callbacks.C_IteratorItemFunction)

-- | Set the value of the “@item@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #item
-- @
clearIteratorItem :: MonadIO m => Iterator -> m ()
clearIteratorItem :: forall (m :: * -> *). MonadIO m => Iterator -> m ()
clearIteratorItem Iterator
s = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Iterator -> (Ptr Iterator -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Iterator
s ((Ptr Iterator -> IO ()) -> IO ())
-> (Ptr Iterator -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Iterator
ptr -> do
    Ptr (FunPtr C_IteratorNextFunction)
-> FunPtr C_IteratorNextFunction -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Iterator
ptr Ptr Iterator -> Int -> Ptr (FunPtr C_IteratorNextFunction)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) (FunPtr C_IteratorNextFunction
forall a. FunPtr a
FP.nullFunPtr :: FunPtr Gst.Callbacks.C_IteratorItemFunction)

#if defined(ENABLE_OVERLOADING)
data IteratorItemFieldInfo
instance AttrInfo IteratorItemFieldInfo where
    type AttrBaseTypeConstraint IteratorItemFieldInfo = (~) Iterator
    type AttrAllowedOps IteratorItemFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint IteratorItemFieldInfo = (~) (FunPtr Gst.Callbacks.C_IteratorItemFunction)
    type AttrTransferTypeConstraint IteratorItemFieldInfo = (~)Gst.Callbacks.IteratorItemFunction
    type AttrTransferType IteratorItemFieldInfo = (FunPtr Gst.Callbacks.C_IteratorItemFunction)
    type AttrGetType IteratorItemFieldInfo = Maybe Gst.Callbacks.IteratorItemFunction
    type AttrLabel IteratorItemFieldInfo = "item"
    type AttrOrigin IteratorItemFieldInfo = Iterator
    attrGet = getIteratorItem
    attrSet = setIteratorItem
    attrConstruct = undefined
    attrClear = clearIteratorItem
    attrTransfer _ v = do
        Gst.Callbacks.mk_IteratorItemFunction (Gst.Callbacks.wrap_IteratorItemFunction Nothing v)
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Iterator.item"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Iterator.html#g:attr:item"
        })

iterator_item :: AttrLabelProxy "item"
iterator_item = AttrLabelProxy

#endif


-- | Get the value of the “@resync@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' iterator #resync
-- @
getIteratorResync :: MonadIO m => Iterator -> m (Maybe Gst.Callbacks.IteratorResyncFunction)
getIteratorResync :: forall (m :: * -> *).
MonadIO m =>
Iterator -> m (Maybe IteratorResyncFunction)
getIteratorResync Iterator
s = IO (Maybe IteratorResyncFunction)
-> m (Maybe IteratorResyncFunction)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe IteratorResyncFunction)
 -> m (Maybe IteratorResyncFunction))
-> IO (Maybe IteratorResyncFunction)
-> m (Maybe IteratorResyncFunction)
forall a b. (a -> b) -> a -> b
$ Iterator
-> (Ptr Iterator -> IO (Maybe IteratorResyncFunction))
-> IO (Maybe IteratorResyncFunction)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Iterator
s ((Ptr Iterator -> IO (Maybe IteratorResyncFunction))
 -> IO (Maybe IteratorResyncFunction))
-> (Ptr Iterator -> IO (Maybe IteratorResyncFunction))
-> IO (Maybe IteratorResyncFunction)
forall a b. (a -> b) -> a -> b
$ \Ptr Iterator
ptr -> do
    FunPtr (Ptr Iterator -> IO ())
val <- Ptr (FunPtr (Ptr Iterator -> IO ()))
-> IO (FunPtr (Ptr Iterator -> IO ()))
forall a. Storable a => Ptr a -> IO a
peek (Ptr Iterator
ptr Ptr Iterator -> Int -> Ptr (FunPtr (Ptr Iterator -> IO ()))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) :: IO (FunPtr Gst.Callbacks.C_IteratorResyncFunction)
    Maybe IteratorResyncFunction
result <- FunPtr (Ptr Iterator -> IO ())
-> (FunPtr (Ptr Iterator -> IO ()) -> IO IteratorResyncFunction)
-> IO (Maybe IteratorResyncFunction)
forall a b. FunPtr a -> (FunPtr a -> IO b) -> IO (Maybe b)
SP.convertFunPtrIfNonNull FunPtr (Ptr Iterator -> IO ())
val ((FunPtr (Ptr Iterator -> IO ()) -> IO IteratorResyncFunction)
 -> IO (Maybe IteratorResyncFunction))
-> (FunPtr (Ptr Iterator -> IO ()) -> IO IteratorResyncFunction)
-> IO (Maybe IteratorResyncFunction)
forall a b. (a -> b) -> a -> b
$ \FunPtr (Ptr Iterator -> IO ())
val' -> do
        let val'' :: IteratorResyncFunction
val'' = FunPtr (Ptr Iterator -> IO ()) -> IteratorResyncFunction
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FunPtr (Ptr Iterator -> IO ()) -> Iterator -> m ()
Gst.Callbacks.dynamic_IteratorResyncFunction FunPtr (Ptr Iterator -> IO ())
val'
        IteratorResyncFunction -> IO IteratorResyncFunction
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IteratorResyncFunction
val''
    Maybe IteratorResyncFunction -> IO (Maybe IteratorResyncFunction)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe IteratorResyncFunction
result

-- | Set the value of the “@resync@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' iterator [ #resync 'Data.GI.Base.Attributes.:=' value ]
-- @
setIteratorResync :: MonadIO m => Iterator -> FunPtr Gst.Callbacks.C_IteratorResyncFunction -> m ()
setIteratorResync :: forall (m :: * -> *).
MonadIO m =>
Iterator -> FunPtr (Ptr Iterator -> IO ()) -> m ()
setIteratorResync Iterator
s FunPtr (Ptr Iterator -> IO ())
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Iterator -> (Ptr Iterator -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Iterator
s ((Ptr Iterator -> IO ()) -> IO ())
-> (Ptr Iterator -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Iterator
ptr -> do
    Ptr (FunPtr (Ptr Iterator -> IO ()))
-> FunPtr (Ptr Iterator -> IO ()) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Iterator
ptr Ptr Iterator -> Int -> Ptr (FunPtr (Ptr Iterator -> IO ()))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) (FunPtr (Ptr Iterator -> IO ())
val :: FunPtr Gst.Callbacks.C_IteratorResyncFunction)

-- | Set the value of the “@resync@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #resync
-- @
clearIteratorResync :: MonadIO m => Iterator -> m ()
clearIteratorResync :: forall (m :: * -> *). MonadIO m => Iterator -> m ()
clearIteratorResync Iterator
s = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Iterator -> (Ptr Iterator -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Iterator
s ((Ptr Iterator -> IO ()) -> IO ())
-> (Ptr Iterator -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Iterator
ptr -> do
    Ptr (FunPtr (Ptr Iterator -> IO ()))
-> FunPtr (Ptr Iterator -> IO ()) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Iterator
ptr Ptr Iterator -> Int -> Ptr (FunPtr (Ptr Iterator -> IO ()))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) (FunPtr (Ptr Iterator -> IO ())
forall a. FunPtr a
FP.nullFunPtr :: FunPtr Gst.Callbacks.C_IteratorResyncFunction)

#if defined(ENABLE_OVERLOADING)
data IteratorResyncFieldInfo
instance AttrInfo IteratorResyncFieldInfo where
    type AttrBaseTypeConstraint IteratorResyncFieldInfo = (~) Iterator
    type AttrAllowedOps IteratorResyncFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint IteratorResyncFieldInfo = (~) (FunPtr Gst.Callbacks.C_IteratorResyncFunction)
    type AttrTransferTypeConstraint IteratorResyncFieldInfo = (~)Gst.Callbacks.IteratorResyncFunction
    type AttrTransferType IteratorResyncFieldInfo = (FunPtr Gst.Callbacks.C_IteratorResyncFunction)
    type AttrGetType IteratorResyncFieldInfo = Maybe Gst.Callbacks.IteratorResyncFunction
    type AttrLabel IteratorResyncFieldInfo = "resync"
    type AttrOrigin IteratorResyncFieldInfo = Iterator
    attrGet = getIteratorResync
    attrSet = setIteratorResync
    attrConstruct = undefined
    attrClear = clearIteratorResync
    attrTransfer _ v = do
        Gst.Callbacks.mk_IteratorResyncFunction (Gst.Callbacks.wrap_IteratorResyncFunction Nothing v)
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Iterator.resync"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Iterator.html#g:attr:resync"
        })

iterator_resync :: AttrLabelProxy "resync"
iterator_resync = AttrLabelProxy

#endif


-- | Get the value of the “@free@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' iterator #free
-- @
getIteratorFree :: MonadIO m => Iterator -> m (Maybe Gst.Callbacks.IteratorFreeFunction)
getIteratorFree :: forall (m :: * -> *).
MonadIO m =>
Iterator -> m (Maybe IteratorResyncFunction)
getIteratorFree Iterator
s = IO (Maybe IteratorResyncFunction)
-> m (Maybe IteratorResyncFunction)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe IteratorResyncFunction)
 -> m (Maybe IteratorResyncFunction))
-> IO (Maybe IteratorResyncFunction)
-> m (Maybe IteratorResyncFunction)
forall a b. (a -> b) -> a -> b
$ Iterator
-> (Ptr Iterator -> IO (Maybe IteratorResyncFunction))
-> IO (Maybe IteratorResyncFunction)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Iterator
s ((Ptr Iterator -> IO (Maybe IteratorResyncFunction))
 -> IO (Maybe IteratorResyncFunction))
-> (Ptr Iterator -> IO (Maybe IteratorResyncFunction))
-> IO (Maybe IteratorResyncFunction)
forall a b. (a -> b) -> a -> b
$ \Ptr Iterator
ptr -> do
    FunPtr (Ptr Iterator -> IO ())
val <- Ptr (FunPtr (Ptr Iterator -> IO ()))
-> IO (FunPtr (Ptr Iterator -> IO ()))
forall a. Storable a => Ptr a -> IO a
peek (Ptr Iterator
ptr Ptr Iterator -> Int -> Ptr (FunPtr (Ptr Iterator -> IO ()))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32) :: IO (FunPtr Gst.Callbacks.C_IteratorFreeFunction)
    Maybe IteratorResyncFunction
result <- FunPtr (Ptr Iterator -> IO ())
-> (FunPtr (Ptr Iterator -> IO ()) -> IO IteratorResyncFunction)
-> IO (Maybe IteratorResyncFunction)
forall a b. FunPtr a -> (FunPtr a -> IO b) -> IO (Maybe b)
SP.convertFunPtrIfNonNull FunPtr (Ptr Iterator -> IO ())
val ((FunPtr (Ptr Iterator -> IO ()) -> IO IteratorResyncFunction)
 -> IO (Maybe IteratorResyncFunction))
-> (FunPtr (Ptr Iterator -> IO ()) -> IO IteratorResyncFunction)
-> IO (Maybe IteratorResyncFunction)
forall a b. (a -> b) -> a -> b
$ \FunPtr (Ptr Iterator -> IO ())
val' -> do
        let val'' :: IteratorResyncFunction
val'' = FunPtr (Ptr Iterator -> IO ()) -> IteratorResyncFunction
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FunPtr (Ptr Iterator -> IO ()) -> Iterator -> m ()
Gst.Callbacks.dynamic_IteratorFreeFunction FunPtr (Ptr Iterator -> IO ())
val'
        IteratorResyncFunction -> IO IteratorResyncFunction
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IteratorResyncFunction
val''
    Maybe IteratorResyncFunction -> IO (Maybe IteratorResyncFunction)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe IteratorResyncFunction
result

-- | Set the value of the “@free@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' iterator [ #free 'Data.GI.Base.Attributes.:=' value ]
-- @
setIteratorFree :: MonadIO m => Iterator -> FunPtr Gst.Callbacks.C_IteratorFreeFunction -> m ()
setIteratorFree :: forall (m :: * -> *).
MonadIO m =>
Iterator -> FunPtr (Ptr Iterator -> IO ()) -> m ()
setIteratorFree Iterator
s FunPtr (Ptr Iterator -> IO ())
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Iterator -> (Ptr Iterator -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Iterator
s ((Ptr Iterator -> IO ()) -> IO ())
-> (Ptr Iterator -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Iterator
ptr -> do
    Ptr (FunPtr (Ptr Iterator -> IO ()))
-> FunPtr (Ptr Iterator -> IO ()) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Iterator
ptr Ptr Iterator -> Int -> Ptr (FunPtr (Ptr Iterator -> IO ()))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32) (FunPtr (Ptr Iterator -> IO ())
val :: FunPtr Gst.Callbacks.C_IteratorFreeFunction)

-- | Set the value of the “@free@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #free
-- @
clearIteratorFree :: MonadIO m => Iterator -> m ()
clearIteratorFree :: forall (m :: * -> *). MonadIO m => Iterator -> m ()
clearIteratorFree Iterator
s = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Iterator -> (Ptr Iterator -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Iterator
s ((Ptr Iterator -> IO ()) -> IO ())
-> (Ptr Iterator -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Iterator
ptr -> do
    Ptr (FunPtr (Ptr Iterator -> IO ()))
-> FunPtr (Ptr Iterator -> IO ()) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Iterator
ptr Ptr Iterator -> Int -> Ptr (FunPtr (Ptr Iterator -> IO ()))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32) (FunPtr (Ptr Iterator -> IO ())
forall a. FunPtr a
FP.nullFunPtr :: FunPtr Gst.Callbacks.C_IteratorFreeFunction)

#if defined(ENABLE_OVERLOADING)
data IteratorFreeFieldInfo
instance AttrInfo IteratorFreeFieldInfo where
    type AttrBaseTypeConstraint IteratorFreeFieldInfo = (~) Iterator
    type AttrAllowedOps IteratorFreeFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint IteratorFreeFieldInfo = (~) (FunPtr Gst.Callbacks.C_IteratorFreeFunction)
    type AttrTransferTypeConstraint IteratorFreeFieldInfo = (~)Gst.Callbacks.IteratorFreeFunction
    type AttrTransferType IteratorFreeFieldInfo = (FunPtr Gst.Callbacks.C_IteratorFreeFunction)
    type AttrGetType IteratorFreeFieldInfo = Maybe Gst.Callbacks.IteratorFreeFunction
    type AttrLabel IteratorFreeFieldInfo = "free"
    type AttrOrigin IteratorFreeFieldInfo = Iterator
    attrGet = getIteratorFree
    attrSet = setIteratorFree
    attrConstruct = undefined
    attrClear = clearIteratorFree
    attrTransfer _ v = do
        Gst.Callbacks.mk_IteratorFreeFunction (Gst.Callbacks.wrap_IteratorFreeFunction Nothing v)
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Iterator.free"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Iterator.html#g:attr:free"
        })

iterator_free :: AttrLabelProxy "free"
iterator_free = AttrLabelProxy

#endif


-- | Get the value of the “@pushed@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' iterator #pushed
-- @
getIteratorPushed :: MonadIO m => Iterator -> m (Maybe Iterator)
getIteratorPushed :: forall (m :: * -> *). MonadIO m => Iterator -> m (Maybe Iterator)
getIteratorPushed Iterator
s = IO (Maybe Iterator) -> m (Maybe Iterator)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Iterator) -> m (Maybe Iterator))
-> IO (Maybe Iterator) -> m (Maybe Iterator)
forall a b. (a -> b) -> a -> b
$ Iterator
-> (Ptr Iterator -> IO (Maybe Iterator)) -> IO (Maybe Iterator)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Iterator
s ((Ptr Iterator -> IO (Maybe Iterator)) -> IO (Maybe Iterator))
-> (Ptr Iterator -> IO (Maybe Iterator)) -> IO (Maybe Iterator)
forall a b. (a -> b) -> a -> b
$ \Ptr Iterator
ptr -> do
    Ptr Iterator
val <- Ptr (Ptr Iterator) -> IO (Ptr Iterator)
forall a. Storable a => Ptr a -> IO a
peek (Ptr Iterator
ptr Ptr Iterator -> Int -> Ptr (Ptr Iterator)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40) :: IO (Ptr Iterator)
    Maybe Iterator
result <- Ptr Iterator
-> (Ptr Iterator -> IO Iterator) -> IO (Maybe Iterator)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull Ptr Iterator
val ((Ptr Iterator -> IO Iterator) -> IO (Maybe Iterator))
-> (Ptr Iterator -> IO Iterator) -> IO (Maybe Iterator)
forall a b. (a -> b) -> a -> b
$ \Ptr Iterator
val' -> do
        Iterator
val'' <- ((ManagedPtr Iterator -> Iterator) -> Ptr Iterator -> IO Iterator
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Iterator -> Iterator
Iterator) Ptr Iterator
val'
        Iterator -> IO Iterator
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Iterator
val''
    Maybe Iterator -> IO (Maybe Iterator)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Iterator
result

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

-- | Set the value of the “@pushed@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #pushed
-- @
clearIteratorPushed :: MonadIO m => Iterator -> m ()
clearIteratorPushed :: forall (m :: * -> *). MonadIO m => Iterator -> m ()
clearIteratorPushed Iterator
s = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Iterator -> (Ptr Iterator -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Iterator
s ((Ptr Iterator -> IO ()) -> IO ())
-> (Ptr Iterator -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Iterator
ptr -> do
    Ptr (Ptr Iterator) -> Ptr Iterator -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Iterator
ptr Ptr Iterator -> Int -> Ptr (Ptr Iterator)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40) (Ptr Iterator
forall a. Ptr a
FP.nullPtr :: Ptr Iterator)

#if defined(ENABLE_OVERLOADING)
data IteratorPushedFieldInfo
instance AttrInfo IteratorPushedFieldInfo where
    type AttrBaseTypeConstraint IteratorPushedFieldInfo = (~) Iterator
    type AttrAllowedOps IteratorPushedFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint IteratorPushedFieldInfo = (~) (Ptr Iterator)
    type AttrTransferTypeConstraint IteratorPushedFieldInfo = (~)(Ptr Iterator)
    type AttrTransferType IteratorPushedFieldInfo = (Ptr Iterator)
    type AttrGetType IteratorPushedFieldInfo = Maybe Iterator
    type AttrLabel IteratorPushedFieldInfo = "pushed"
    type AttrOrigin IteratorPushedFieldInfo = Iterator
    attrGet = getIteratorPushed
    attrSet = setIteratorPushed
    attrConstruct = undefined
    attrClear = clearIteratorPushed
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Iterator.pushed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Iterator.html#g:attr:pushed"
        })

iterator_pushed :: AttrLabelProxy "pushed"
iterator_pushed = AttrLabelProxy

#endif


-- | 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' iterator #type
-- @
getIteratorType :: MonadIO m => Iterator -> m GType
getIteratorType :: forall (m :: * -> *). MonadIO m => Iterator -> m GType
getIteratorType Iterator
s = IO GType -> m GType
forall a. IO a -> m a
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
$ Iterator -> (Ptr Iterator -> IO GType) -> IO GType
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Iterator
s ((Ptr Iterator -> IO GType) -> IO GType)
-> (Ptr Iterator -> IO GType) -> IO GType
forall a b. (a -> b) -> a -> b
$ \Ptr Iterator
ptr -> do
    CGType
val <- Ptr CGType -> IO CGType
forall a. Storable a => Ptr a -> IO a
peek (Ptr Iterator
ptr Ptr Iterator -> Int -> Ptr CGType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48) :: IO CGType
    let val' :: GType
val' = CGType -> GType
GType CGType
val
    GType -> IO GType
forall a. a -> IO a
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' iterator [ #type 'Data.GI.Base.Attributes.:=' value ]
-- @
setIteratorType :: MonadIO m => Iterator -> GType -> m ()
setIteratorType :: forall (m :: * -> *). MonadIO m => Iterator -> GType -> m ()
setIteratorType Iterator
s GType
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Iterator -> (Ptr Iterator -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Iterator
s ((Ptr Iterator -> IO ()) -> IO ())
-> (Ptr Iterator -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Iterator
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 Iterator
ptr Ptr Iterator -> Int -> Ptr CGType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48) (CGType
val' :: CGType)

#if defined(ENABLE_OVERLOADING)
data IteratorTypeFieldInfo
instance AttrInfo IteratorTypeFieldInfo where
    type AttrBaseTypeConstraint IteratorTypeFieldInfo = (~) Iterator
    type AttrAllowedOps IteratorTypeFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint IteratorTypeFieldInfo = (~) GType
    type AttrTransferTypeConstraint IteratorTypeFieldInfo = (~)GType
    type AttrTransferType IteratorTypeFieldInfo = GType
    type AttrGetType IteratorTypeFieldInfo = GType
    type AttrLabel IteratorTypeFieldInfo = "type"
    type AttrOrigin IteratorTypeFieldInfo = Iterator
    attrGet = getIteratorType
    attrSet = setIteratorType
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Iterator.type"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Iterator.html#g:attr:type"
        })

iterator_type :: AttrLabelProxy "type"
iterator_type = AttrLabelProxy

#endif


-- | Get the value of the “@lock@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' iterator #lock
-- @
getIteratorLock :: MonadIO m => Iterator -> m (Maybe GLib.Mutex.Mutex)
getIteratorLock :: forall (m :: * -> *). MonadIO m => Iterator -> m (Maybe Mutex)
getIteratorLock Iterator
s = IO (Maybe Mutex) -> m (Maybe Mutex)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Mutex) -> m (Maybe Mutex))
-> IO (Maybe Mutex) -> m (Maybe Mutex)
forall a b. (a -> b) -> a -> b
$ Iterator -> (Ptr Iterator -> IO (Maybe Mutex)) -> IO (Maybe Mutex)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Iterator
s ((Ptr Iterator -> IO (Maybe Mutex)) -> IO (Maybe Mutex))
-> (Ptr Iterator -> IO (Maybe Mutex)) -> IO (Maybe Mutex)
forall a b. (a -> b) -> a -> b
$ \Ptr Iterator
ptr -> do
    Ptr Mutex
val <- Ptr (Ptr Mutex) -> IO (Ptr Mutex)
forall a. Storable a => Ptr a -> IO a
peek (Ptr Iterator
ptr Ptr Iterator -> Int -> Ptr (Ptr Mutex)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56) :: IO (Ptr GLib.Mutex.Mutex)
    Maybe Mutex
result <- Ptr Mutex -> (Ptr Mutex -> IO Mutex) -> IO (Maybe Mutex)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull Ptr Mutex
val ((Ptr Mutex -> IO Mutex) -> IO (Maybe Mutex))
-> (Ptr Mutex -> IO Mutex) -> IO (Maybe Mutex)
forall a b. (a -> b) -> a -> b
$ \Ptr Mutex
val' -> do
        Mutex
val'' <- ((ManagedPtr Mutex -> Mutex) -> Ptr Mutex -> IO Mutex
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr Mutex -> Mutex
GLib.Mutex.Mutex) Ptr Mutex
val'
        Mutex -> IO Mutex
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Mutex
val''
    Maybe Mutex -> IO (Maybe Mutex)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Mutex
result

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

-- | Set the value of the “@lock@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #lock
-- @
clearIteratorLock :: MonadIO m => Iterator -> m ()
clearIteratorLock :: forall (m :: * -> *). MonadIO m => Iterator -> m ()
clearIteratorLock Iterator
s = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Iterator -> (Ptr Iterator -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Iterator
s ((Ptr Iterator -> IO ()) -> IO ())
-> (Ptr Iterator -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Iterator
ptr -> do
    Ptr (Ptr Mutex) -> Ptr Mutex -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Iterator
ptr Ptr Iterator -> Int -> Ptr (Ptr Mutex)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56) (Ptr Mutex
forall a. Ptr a
FP.nullPtr :: Ptr GLib.Mutex.Mutex)

#if defined(ENABLE_OVERLOADING)
data IteratorLockFieldInfo
instance AttrInfo IteratorLockFieldInfo where
    type AttrBaseTypeConstraint IteratorLockFieldInfo = (~) Iterator
    type AttrAllowedOps IteratorLockFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint IteratorLockFieldInfo = (~) (Ptr GLib.Mutex.Mutex)
    type AttrTransferTypeConstraint IteratorLockFieldInfo = (~)(Ptr GLib.Mutex.Mutex)
    type AttrTransferType IteratorLockFieldInfo = (Ptr GLib.Mutex.Mutex)
    type AttrGetType IteratorLockFieldInfo = Maybe GLib.Mutex.Mutex
    type AttrLabel IteratorLockFieldInfo = "lock"
    type AttrOrigin IteratorLockFieldInfo = Iterator
    attrGet = getIteratorLock
    attrSet = setIteratorLock
    attrConstruct = undefined
    attrClear = clearIteratorLock
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Iterator.lock"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Iterator.html#g:attr:lock"
        })

iterator_lock :: AttrLabelProxy "lock"
iterator_lock = AttrLabelProxy

#endif


-- | Get the value of the “@cookie@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' iterator #cookie
-- @
getIteratorCookie :: MonadIO m => Iterator -> m Word32
getIteratorCookie :: forall (m :: * -> *). MonadIO m => Iterator -> m Word32
getIteratorCookie Iterator
s = IO Word32 -> m Word32
forall a. IO a -> m a
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
$ Iterator -> (Ptr Iterator -> IO Word32) -> IO Word32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Iterator
s ((Ptr Iterator -> IO Word32) -> IO Word32)
-> (Ptr Iterator -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ \Ptr Iterator
ptr -> do
    Word32
val <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek (Ptr Iterator
ptr Ptr Iterator -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64) :: IO Word32
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
val

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

#if defined(ENABLE_OVERLOADING)
data IteratorCookieFieldInfo
instance AttrInfo IteratorCookieFieldInfo where
    type AttrBaseTypeConstraint IteratorCookieFieldInfo = (~) Iterator
    type AttrAllowedOps IteratorCookieFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint IteratorCookieFieldInfo = (~) Word32
    type AttrTransferTypeConstraint IteratorCookieFieldInfo = (~)Word32
    type AttrTransferType IteratorCookieFieldInfo = Word32
    type AttrGetType IteratorCookieFieldInfo = Word32
    type AttrLabel IteratorCookieFieldInfo = "cookie"
    type AttrOrigin IteratorCookieFieldInfo = Iterator
    attrGet = getIteratorCookie
    attrSet = setIteratorCookie
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Iterator.cookie"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Iterator.html#g:attr:cookie"
        })

iterator_cookie :: AttrLabelProxy "cookie"
iterator_cookie = AttrLabelProxy

#endif


-- | Get the value of the “@master_cookie@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' iterator #masterCookie
-- @
getIteratorMasterCookie :: MonadIO m => Iterator -> m Word32
getIteratorMasterCookie :: forall (m :: * -> *). MonadIO m => Iterator -> m Word32
getIteratorMasterCookie Iterator
s = IO Word32 -> m Word32
forall a. IO a -> m a
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
$ Iterator -> (Ptr Iterator -> IO Word32) -> IO Word32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Iterator
s ((Ptr Iterator -> IO Word32) -> IO Word32)
-> (Ptr Iterator -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ \Ptr Iterator
ptr -> do
    Word32
val <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek (Ptr Iterator
ptr Ptr Iterator -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
72) :: IO Word32
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
val

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

#if defined(ENABLE_OVERLOADING)
data IteratorMasterCookieFieldInfo
instance AttrInfo IteratorMasterCookieFieldInfo where
    type AttrBaseTypeConstraint IteratorMasterCookieFieldInfo = (~) Iterator
    type AttrAllowedOps IteratorMasterCookieFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint IteratorMasterCookieFieldInfo = (~) Word32
    type AttrTransferTypeConstraint IteratorMasterCookieFieldInfo = (~)Word32
    type AttrTransferType IteratorMasterCookieFieldInfo = Word32
    type AttrGetType IteratorMasterCookieFieldInfo = Word32
    type AttrLabel IteratorMasterCookieFieldInfo = "master_cookie"
    type AttrOrigin IteratorMasterCookieFieldInfo = Iterator
    attrGet = getIteratorMasterCookie
    attrSet = setIteratorMasterCookie
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Iterator.masterCookie"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Iterator.html#g:attr:masterCookie"
        })

iterator_masterCookie :: AttrLabelProxy "masterCookie"
iterator_masterCookie = AttrLabelProxy

#endif


-- | Get the value of the “@size@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' iterator #size
-- @
getIteratorSize :: MonadIO m => Iterator -> m Word32
getIteratorSize :: forall (m :: * -> *). MonadIO m => Iterator -> m Word32
getIteratorSize Iterator
s = IO Word32 -> m Word32
forall a. IO a -> m a
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
$ Iterator -> (Ptr Iterator -> IO Word32) -> IO Word32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Iterator
s ((Ptr Iterator -> IO Word32) -> IO Word32)
-> (Ptr Iterator -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ \Ptr Iterator
ptr -> do
    Word32
val <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek (Ptr Iterator
ptr Ptr Iterator -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
80) :: IO Word32
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
val

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

#if defined(ENABLE_OVERLOADING)
data IteratorSizeFieldInfo
instance AttrInfo IteratorSizeFieldInfo where
    type AttrBaseTypeConstraint IteratorSizeFieldInfo = (~) Iterator
    type AttrAllowedOps IteratorSizeFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint IteratorSizeFieldInfo = (~) Word32
    type AttrTransferTypeConstraint IteratorSizeFieldInfo = (~)Word32
    type AttrTransferType IteratorSizeFieldInfo = Word32
    type AttrGetType IteratorSizeFieldInfo = Word32
    type AttrLabel IteratorSizeFieldInfo = "size"
    type AttrOrigin IteratorSizeFieldInfo = Iterator
    attrGet = getIteratorSize
    attrSet = setIteratorSize
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Iterator.size"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Iterator.html#g:attr:size"
        })

iterator_size :: AttrLabelProxy "size"
iterator_size = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Iterator
type instance O.AttributeList Iterator = IteratorAttributeList
type IteratorAttributeList = ('[ '("copy", IteratorCopyFieldInfo), '("next", IteratorNextFieldInfo), '("item", IteratorItemFieldInfo), '("resync", IteratorResyncFieldInfo), '("free", IteratorFreeFieldInfo), '("pushed", IteratorPushedFieldInfo), '("type", IteratorTypeFieldInfo), '("lock", IteratorLockFieldInfo), '("cookie", IteratorCookieFieldInfo), '("masterCookie", IteratorMasterCookieFieldInfo), '("size", IteratorSizeFieldInfo)] :: [(Symbol, *)])
#endif

-- method Iterator::new_single
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "type"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GType of the passed object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "object"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "object that this iterator should return"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Iterator" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_iterator_new_single" gst_iterator_new_single :: 
    CGType ->                               -- type : TBasicType TGType
    Ptr GValue ->                           -- object : TGValue
    IO (Ptr Iterator)

-- | This t'GI.Gst.Structs.Iterator.Iterator' is a convenient iterator for the common
-- case where a t'GI.Gst.Structs.Iterator.Iterator' needs to be returned but only
-- a single object has to be considered. This happens often
-- for the t'GI.Gst.Callbacks.PadIterIntLinkFunction'.
iteratorNewSingle ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GType
    -- ^ /@type@/: t'GType' of the passed object
    -> GValue
    -- ^ /@object@/: object that this iterator should return
    -> m Iterator
    -- ^ __Returns:__ the new t'GI.Gst.Structs.Iterator.Iterator' for /@object@/.
iteratorNewSingle :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
GType -> GValue -> m Iterator
iteratorNewSingle GType
type_ GValue
object = IO Iterator -> m Iterator
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Iterator -> m Iterator) -> IO Iterator -> m Iterator
forall a b. (a -> b) -> a -> b
$ do
    let type_' :: CGType
type_' = GType -> CGType
gtypeToCGType GType
type_
    Ptr GValue
object' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
object
    Ptr Iterator
result <- CGType -> Ptr GValue -> IO (Ptr Iterator)
gst_iterator_new_single CGType
type_' Ptr GValue
object'
    Text -> Ptr Iterator -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"iteratorNewSingle" Ptr Iterator
result
    Iterator
result' <- ((ManagedPtr Iterator -> Iterator) -> Ptr Iterator -> IO Iterator
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Iterator -> Iterator
Iterator) Ptr Iterator
result
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
object
    Iterator -> IO Iterator
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Iterator
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "gst_iterator_copy" gst_iterator_copy :: 
    Ptr Iterator ->                         -- it : TInterface (Name {namespace = "Gst", name = "Iterator"})
    IO (Ptr Iterator)

-- | Copy the iterator and its state.
iteratorCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Iterator
    -- ^ /@it@/: a t'GI.Gst.Structs.Iterator.Iterator'
    -> m Iterator
    -- ^ __Returns:__ a new copy of /@it@/.
iteratorCopy :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Iterator -> m Iterator
iteratorCopy Iterator
it = IO Iterator -> m Iterator
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Iterator -> m Iterator) -> IO Iterator -> m Iterator
forall a b. (a -> b) -> a -> b
$ do
    Ptr Iterator
it' <- Iterator -> IO (Ptr Iterator)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Iterator
it
    Ptr Iterator
result <- Ptr Iterator -> IO (Ptr Iterator)
gst_iterator_copy Ptr Iterator
it'
    Text -> Ptr Iterator -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"iteratorCopy" Ptr Iterator
result
    Iterator
result' <- ((ManagedPtr Iterator -> Iterator) -> Ptr Iterator -> IO Iterator
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Iterator -> Iterator
Iterator) Ptr Iterator
result
    IteratorResyncFunction
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Iterator
it
    Iterator -> IO Iterator
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Iterator
result'

#if defined(ENABLE_OVERLOADING)
data IteratorCopyMethodInfo
instance (signature ~ (m Iterator), MonadIO m) => O.OverloadedMethod IteratorCopyMethodInfo Iterator signature where
    overloadedMethod = iteratorCopy

instance O.OverloadedMethodInfo IteratorCopyMethodInfo Iterator where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Iterator.iteratorCopy",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Iterator.html#v:iteratorCopy"
        })


#endif

-- method Iterator::filter
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "it"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Iterator" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstIterator to filter"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "func"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "CompareFunc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the compare function to select elements"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeCall
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data passed to the compare function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Iterator" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_iterator_filter" gst_iterator_filter :: 
    Ptr Iterator ->                         -- it : TInterface (Name {namespace = "Gst", name = "Iterator"})
    FunPtr GLib.Callbacks.C_CompareFunc ->  -- func : TInterface (Name {namespace = "GLib", name = "CompareFunc"})
    Ptr GValue ->                           -- user_data : TGValue
    IO (Ptr Iterator)

-- | Create a new iterator from an existing iterator. The new iterator
-- will only return those elements that match the given compare function /@func@/.
-- The first parameter that is passed to /@func@/ is the t'GI.GObject.Structs.Value.Value' of the current
-- iterator element and the second parameter is /@userData@/. /@func@/ should
-- return 0 for elements that should be included in the filtered iterator.
-- 
-- When this iterator is freed, /@it@/ will also be freed.
iteratorFilter ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Iterator
    -- ^ /@it@/: The t'GI.Gst.Structs.Iterator.Iterator' to filter
    -> GLib.Callbacks.CompareFunc
    -- ^ /@func@/: the compare function to select elements
    -> GValue
    -- ^ /@userData@/: user data passed to the compare function
    -> m Iterator
    -- ^ __Returns:__ a new t'GI.Gst.Structs.Iterator.Iterator'.
    -- 
    -- MT safe.
iteratorFilter :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Iterator -> CompareFunc -> GValue -> m Iterator
iteratorFilter Iterator
it CompareFunc
func GValue
userData = IO Iterator -> m Iterator
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Iterator -> m Iterator) -> IO Iterator -> m Iterator
forall a b. (a -> b) -> a -> b
$ do
    Ptr Iterator
it' <- Iterator -> IO (Ptr Iterator)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Iterator
it
    FunPtr CompareFunc
func' <- CompareFunc -> IO (FunPtr CompareFunc)
GLib.Callbacks.mk_CompareFunc (Maybe (Ptr (FunPtr CompareFunc)) -> CompareFunc -> CompareFunc
GLib.Callbacks.wrap_CompareFunc Maybe (Ptr (FunPtr CompareFunc))
forall a. Maybe a
Nothing CompareFunc
func)
    Ptr GValue
userData' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
userData
    Ptr Iterator
result <- Ptr Iterator
-> FunPtr CompareFunc -> Ptr GValue -> IO (Ptr Iterator)
gst_iterator_filter Ptr Iterator
it' FunPtr CompareFunc
func' Ptr GValue
userData'
    Text -> Ptr Iterator -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"iteratorFilter" Ptr Iterator
result
    Iterator
result' <- ((ManagedPtr Iterator -> Iterator) -> Ptr Iterator -> IO Iterator
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Iterator -> Iterator
Iterator) Ptr Iterator
result
    Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr CompareFunc -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr CompareFunc
func'
    IteratorResyncFunction
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Iterator
it
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
userData
    Iterator -> IO Iterator
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Iterator
result'

#if defined(ENABLE_OVERLOADING)
data IteratorFilterMethodInfo
instance (signature ~ (GLib.Callbacks.CompareFunc -> GValue -> m Iterator), MonadIO m) => O.OverloadedMethod IteratorFilterMethodInfo Iterator signature where
    overloadedMethod = iteratorFilter

instance O.OverloadedMethodInfo IteratorFilterMethodInfo Iterator where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Iterator.iteratorFilter",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Iterator.html#v:iteratorFilter"
        })


#endif

-- method Iterator::find_custom
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "it"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Iterator" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstIterator to iterate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "func"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "CompareFunc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the compare function to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeCall
--           , argClosure = 3
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "elem"
--           , argType = TGValue
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "pointer to a #GValue where to store the result"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data passed to the compare function"
--                 , 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_iterator_find_custom" gst_iterator_find_custom :: 
    Ptr Iterator ->                         -- it : TInterface (Name {namespace = "Gst", name = "Iterator"})
    FunPtr GLib.Callbacks.C_CompareFunc ->  -- func : TInterface (Name {namespace = "GLib", name = "CompareFunc"})
    Ptr GValue ->                           -- elem : TGValue
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO CInt

-- | Find the first element in /@it@/ that matches the compare function /@func@/.
-- /@func@/ should return 0 when the element is found. The first parameter
-- to /@func@/ will be the current element of the iterator and the
-- second parameter will be /@userData@/.
-- The result will be stored in /@elem@/ if a result is found.
-- 
-- The iterator will not be freed.
-- 
-- This function will return 'P.False' if an error happened to the iterator
-- or if the element wasn\'t found.
iteratorFindCustom ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Iterator
    -- ^ /@it@/: The t'GI.Gst.Structs.Iterator.Iterator' to iterate
    -> GLib.Callbacks.CompareFunc
    -- ^ /@func@/: the compare function to use
    -> m ((Bool, GValue))
    -- ^ __Returns:__ Returns 'P.True' if the element was found, else 'P.False'.
    -- 
    -- MT safe.
iteratorFindCustom :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Iterator -> CompareFunc -> m (Bool, GValue)
iteratorFindCustom Iterator
it CompareFunc
func = IO (Bool, GValue) -> m (Bool, GValue)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, GValue) -> m (Bool, GValue))
-> IO (Bool, GValue) -> m (Bool, GValue)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Iterator
it' <- Iterator -> IO (Ptr Iterator)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Iterator
it
    FunPtr CompareFunc
func' <- CompareFunc -> IO (FunPtr CompareFunc)
GLib.Callbacks.mk_CompareFunc (Maybe (Ptr (FunPtr CompareFunc)) -> CompareFunc -> CompareFunc
GLib.Callbacks.wrap_CompareFunc Maybe (Ptr (FunPtr CompareFunc))
forall a. Maybe a
Nothing CompareFunc
func)
    Ptr GValue
elem <- Int -> IO (Ptr GValue)
forall a. Int -> IO (Ptr a)
SP.callocBytes Int
24 :: IO (Ptr GValue)
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    CInt
result <- Ptr Iterator
-> FunPtr CompareFunc -> Ptr GValue -> Ptr () -> IO CInt
gst_iterator_find_custom Ptr Iterator
it' FunPtr CompareFunc
func' Ptr GValue
elem Ptr ()
forall a. Ptr a
userData
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    GValue
elem' <- Ptr GValue -> IO GValue
B.GValue.wrapGValuePtr Ptr GValue
elem
    Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr CompareFunc -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr CompareFunc
func'
    IteratorResyncFunction
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Iterator
it
    (Bool, GValue) -> IO (Bool, GValue)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', GValue
elem')

#if defined(ENABLE_OVERLOADING)
data IteratorFindCustomMethodInfo
instance (signature ~ (GLib.Callbacks.CompareFunc -> m ((Bool, GValue))), MonadIO m) => O.OverloadedMethod IteratorFindCustomMethodInfo Iterator signature where
    overloadedMethod = iteratorFindCustom

instance O.OverloadedMethodInfo IteratorFindCustomMethodInfo Iterator where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Iterator.iteratorFindCustom",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Iterator.html#v:iteratorFindCustom"
        })


#endif

-- method Iterator::fold
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "it"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Iterator" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstIterator to fold over"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "func"
--           , argType =
--               TInterface
--                 Name { namespace = "Gst" , name = "IteratorFoldFunction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the fold function" , sinceVersion = Nothing }
--           , argScope = ScopeTypeCall
--           , argClosure = 3
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "ret"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the seed value passed to the fold function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data passed to the fold function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gst" , name = "IteratorResult" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_iterator_fold" gst_iterator_fold :: 
    Ptr Iterator ->                         -- it : TInterface (Name {namespace = "Gst", name = "Iterator"})
    FunPtr Gst.Callbacks.C_IteratorFoldFunction -> -- func : TInterface (Name {namespace = "Gst", name = "IteratorFoldFunction"})
    Ptr GValue ->                           -- ret : TGValue
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO CUInt

-- | Folds /@func@/ over the elements of /@iter@/. That is to say, /@func@/ will be called
-- as /@func@/ (object, /@ret@/, /@userData@/) for each object in /@it@/. The normal use
-- of this procedure is to accumulate the results of operating on the objects in
-- /@ret@/.
-- 
-- This procedure can be used (and is used internally) to implement the
-- 'GI.Gst.Structs.Iterator.iteratorForeach' and 'GI.Gst.Structs.Iterator.iteratorFindCustom' operations.
-- 
-- The fold will proceed as long as /@func@/ returns 'P.True'. When the iterator has no
-- more arguments, 'GI.Gst.Enums.IteratorResultDone' will be returned. If /@func@/ returns 'P.False',
-- the fold will stop, and 'GI.Gst.Enums.IteratorResultOk' will be returned. Errors or resyncs
-- will cause fold to return 'GI.Gst.Enums.IteratorResultError' or 'GI.Gst.Enums.IteratorResultResync' as
-- appropriate.
-- 
-- The iterator will not be freed.
iteratorFold ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Iterator
    -- ^ /@it@/: The t'GI.Gst.Structs.Iterator.Iterator' to fold over
    -> Gst.Callbacks.IteratorFoldFunction
    -- ^ /@func@/: the fold function
    -> GValue
    -- ^ /@ret@/: the seed value passed to the fold function
    -> m Gst.Enums.IteratorResult
    -- ^ __Returns:__ A t'GI.Gst.Enums.IteratorResult', as described above.
    -- 
    -- MT safe.
iteratorFold :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Iterator -> IteratorFoldFunction -> GValue -> m IteratorResult
iteratorFold Iterator
it IteratorFoldFunction
func GValue
ret = IO IteratorResult -> m IteratorResult
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IteratorResult -> m IteratorResult)
-> IO IteratorResult -> m IteratorResult
forall a b. (a -> b) -> a -> b
$ do
    Ptr Iterator
it' <- Iterator -> IO (Ptr Iterator)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Iterator
it
    FunPtr C_IteratorFoldFunction
func' <- C_IteratorFoldFunction -> IO (FunPtr C_IteratorFoldFunction)
Gst.Callbacks.mk_IteratorFoldFunction (Maybe (Ptr (FunPtr C_IteratorFoldFunction))
-> IteratorFoldFunction_WithClosures -> C_IteratorFoldFunction
Gst.Callbacks.wrap_IteratorFoldFunction Maybe (Ptr (FunPtr C_IteratorFoldFunction))
forall a. Maybe a
Nothing (IteratorFoldFunction -> IteratorFoldFunction_WithClosures
Gst.Callbacks.drop_closures_IteratorFoldFunction IteratorFoldFunction
func))
    Ptr GValue
ret' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
ret
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    CUInt
result <- Ptr Iterator
-> FunPtr C_IteratorFoldFunction
-> Ptr GValue
-> Ptr ()
-> IO CUInt
gst_iterator_fold Ptr Iterator
it' FunPtr C_IteratorFoldFunction
func' Ptr GValue
ret' Ptr ()
forall a. Ptr a
userData
    let result' :: IteratorResult
result' = (Int -> IteratorResult
forall a. Enum a => Int -> a
toEnum (Int -> IteratorResult)
-> (CUInt -> Int) -> CUInt -> IteratorResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
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_IteratorFoldFunction -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_IteratorFoldFunction
func'
    IteratorResyncFunction
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Iterator
it
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
ret
    IteratorResult -> IO IteratorResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IteratorResult
result'

#if defined(ENABLE_OVERLOADING)
data IteratorFoldMethodInfo
instance (signature ~ (Gst.Callbacks.IteratorFoldFunction -> GValue -> m Gst.Enums.IteratorResult), MonadIO m) => O.OverloadedMethod IteratorFoldMethodInfo Iterator signature where
    overloadedMethod = iteratorFold

instance O.OverloadedMethodInfo IteratorFoldMethodInfo Iterator where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Iterator.iteratorFold",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Iterator.html#v:iteratorFold"
        })


#endif

-- method Iterator::foreach
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "it"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Iterator" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstIterator to iterate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "func"
--           , argType =
--               TInterface
--                 Name { namespace = "Gst" , name = "IteratorForeachFunction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the function to call for each element."
--                 , 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 "user data passed to the function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gst" , name = "IteratorResult" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_iterator_foreach" gst_iterator_foreach :: 
    Ptr Iterator ->                         -- it : TInterface (Name {namespace = "Gst", name = "Iterator"})
    FunPtr Gst.Callbacks.C_IteratorForeachFunction -> -- func : TInterface (Name {namespace = "Gst", name = "IteratorForeachFunction"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO CUInt

-- | Iterate over all element of /@it@/ and call the given function /@func@/ for
-- each element.
iteratorForeach ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Iterator
    -- ^ /@it@/: The t'GI.Gst.Structs.Iterator.Iterator' to iterate
    -> Gst.Callbacks.IteratorForeachFunction
    -- ^ /@func@/: the function to call for each element.
    -> m Gst.Enums.IteratorResult
    -- ^ __Returns:__ the result call to 'GI.Gst.Structs.Iterator.iteratorFold'. The iterator will not be
    -- freed.
    -- 
    -- MT safe.
iteratorForeach :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Iterator -> (GValue -> IO ()) -> m IteratorResult
iteratorForeach Iterator
it GValue -> IO ()
func = IO IteratorResult -> m IteratorResult
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IteratorResult -> m IteratorResult)
-> IO IteratorResult -> m IteratorResult
forall a b. (a -> b) -> a -> b
$ do
    Ptr Iterator
it' <- Iterator -> IO (Ptr Iterator)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Iterator
it
    FunPtr C_IteratorForeachFunction
func' <- C_IteratorForeachFunction -> IO (FunPtr C_IteratorForeachFunction)
Gst.Callbacks.mk_IteratorForeachFunction (Maybe (Ptr (FunPtr C_IteratorForeachFunction))
-> IteratorForeachFunction_WithClosures
-> C_IteratorForeachFunction
Gst.Callbacks.wrap_IteratorForeachFunction Maybe (Ptr (FunPtr C_IteratorForeachFunction))
forall a. Maybe a
Nothing ((GValue -> IO ()) -> IteratorForeachFunction_WithClosures
Gst.Callbacks.drop_closures_IteratorForeachFunction GValue -> IO ()
func))
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    CUInt
result <- Ptr Iterator
-> FunPtr C_IteratorForeachFunction -> Ptr () -> IO CUInt
gst_iterator_foreach Ptr Iterator
it' FunPtr C_IteratorForeachFunction
func' Ptr ()
forall a. Ptr a
userData
    let result' :: IteratorResult
result' = (Int -> IteratorResult
forall a. Enum a => Int -> a
toEnum (Int -> IteratorResult)
-> (CUInt -> Int) -> CUInt -> IteratorResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
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_IteratorForeachFunction -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_IteratorForeachFunction
func'
    IteratorResyncFunction
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Iterator
it
    IteratorResult -> IO IteratorResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IteratorResult
result'

#if defined(ENABLE_OVERLOADING)
data IteratorForeachMethodInfo
instance (signature ~ (Gst.Callbacks.IteratorForeachFunction -> m Gst.Enums.IteratorResult), MonadIO m) => O.OverloadedMethod IteratorForeachMethodInfo Iterator signature where
    overloadedMethod = iteratorForeach

instance O.OverloadedMethodInfo IteratorForeachMethodInfo Iterator where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Iterator.iteratorForeach",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Iterator.html#v:iteratorForeach"
        })


#endif

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

foreign import ccall "gst_iterator_free" gst_iterator_free :: 
    Ptr Iterator ->                         -- it : TInterface (Name {namespace = "Gst", name = "Iterator"})
    IO ()

-- | Free the iterator.
-- 
-- MT safe.
iteratorFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Iterator
    -- ^ /@it@/: The t'GI.Gst.Structs.Iterator.Iterator' to free
    -> m ()
iteratorFree :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Iterator -> m ()
iteratorFree Iterator
it = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Iterator
it' <- Iterator -> IO (Ptr Iterator)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Iterator
it
    Ptr Iterator -> IO ()
gst_iterator_free Ptr Iterator
it'
    IteratorResyncFunction
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Iterator
it
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IteratorFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod IteratorFreeMethodInfo Iterator signature where
    overloadedMethod = iteratorFree

instance O.OverloadedMethodInfo IteratorFreeMethodInfo Iterator where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Iterator.iteratorFree",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Iterator.html#v:iteratorFree"
        })


#endif

-- method Iterator::next
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "it"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Iterator" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstIterator to iterate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "elem"
--           , argType = TGValue
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "pointer to hold next element"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gst" , name = "IteratorResult" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_iterator_next" gst_iterator_next :: 
    Ptr Iterator ->                         -- it : TInterface (Name {namespace = "Gst", name = "Iterator"})
    Ptr GValue ->                           -- elem : TGValue
    IO CUInt

-- | Get the next item from the iterator in /@elem@/.
-- 
-- Only when this function returns 'GI.Gst.Enums.IteratorResultOk', /@elem@/ will contain a valid
-- value. /@elem@/ must have been initialized to the type of the iterator or
-- initialized to zeroes with 'GI.GObject.Structs.Value.valueUnset'. The caller is responsible for
-- unsetting or resetting /@elem@/ with 'GI.GObject.Structs.Value.valueUnset' or 'GI.GObject.Structs.Value.valueReset'
-- after usage.
-- 
-- When this function returns 'GI.Gst.Enums.IteratorResultDone', no more elements can be
-- retrieved from /@it@/.
-- 
-- A return value of 'GI.Gst.Enums.IteratorResultResync' indicates that the element list was
-- concurrently updated. The user of /@it@/ should call 'GI.Gst.Structs.Iterator.iteratorResync' to
-- get the newly updated list.
-- 
-- A return value of 'GI.Gst.Enums.IteratorResultError' indicates an unrecoverable fatal error.
iteratorNext ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Iterator
    -- ^ /@it@/: The t'GI.Gst.Structs.Iterator.Iterator' to iterate
    -> m ((Gst.Enums.IteratorResult, GValue))
    -- ^ __Returns:__ The result of the iteration. Unset /@elem@/ after usage.
    -- 
    -- MT safe.
iteratorNext :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Iterator -> m (IteratorResult, GValue)
iteratorNext Iterator
it = IO (IteratorResult, GValue) -> m (IteratorResult, GValue)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IteratorResult, GValue) -> m (IteratorResult, GValue))
-> IO (IteratorResult, GValue) -> m (IteratorResult, GValue)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Iterator
it' <- Iterator -> IO (Ptr Iterator)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Iterator
it
    Ptr GValue
elem <- Int -> IO (Ptr GValue)
forall a. Int -> IO (Ptr a)
SP.callocBytes Int
24 :: IO (Ptr GValue)
    CUInt
result <- C_IteratorNextFunction
gst_iterator_next Ptr Iterator
it' Ptr GValue
elem
    let result' :: IteratorResult
result' = (Int -> IteratorResult
forall a. Enum a => Int -> a
toEnum (Int -> IteratorResult)
-> (CUInt -> Int) -> CUInt -> IteratorResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    GValue
elem' <- Ptr GValue -> IO GValue
B.GValue.wrapGValuePtr Ptr GValue
elem
    IteratorResyncFunction
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Iterator
it
    (IteratorResult, GValue) -> IO (IteratorResult, GValue)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IteratorResult
result', GValue
elem')

#if defined(ENABLE_OVERLOADING)
data IteratorNextMethodInfo
instance (signature ~ (m ((Gst.Enums.IteratorResult, GValue))), MonadIO m) => O.OverloadedMethod IteratorNextMethodInfo Iterator signature where
    overloadedMethod = iteratorNext

instance O.OverloadedMethodInfo IteratorNextMethodInfo Iterator where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Iterator.iteratorNext",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Iterator.html#v:iteratorNext"
        })


#endif

-- method Iterator::push
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "it"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Iterator" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstIterator to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "other"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Iterator" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstIterator to push"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_iterator_push" gst_iterator_push :: 
    Ptr Iterator ->                         -- it : TInterface (Name {namespace = "Gst", name = "Iterator"})
    Ptr Iterator ->                         -- other : TInterface (Name {namespace = "Gst", name = "Iterator"})
    IO ()

-- | Pushes /@other@/ iterator onto /@it@/. All calls performed on /@it@/ are
-- forwarded to /@other@/. If /@other@/ returns 'GI.Gst.Enums.IteratorResultDone', it is
-- popped again and calls are handled by /@it@/ again.
-- 
-- This function is mainly used by objects implementing the iterator
-- next function to recurse into substructures.
-- 
-- When 'GI.Gst.Structs.Iterator.iteratorResync' is called on /@it@/, /@other@/ will automatically be
-- popped.
-- 
-- MT safe.
iteratorPush ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Iterator
    -- ^ /@it@/: The t'GI.Gst.Structs.Iterator.Iterator' to use
    -> Iterator
    -- ^ /@other@/: The t'GI.Gst.Structs.Iterator.Iterator' to push
    -> m ()
iteratorPush :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Iterator -> Iterator -> m ()
iteratorPush Iterator
it Iterator
other = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Iterator
it' <- Iterator -> IO (Ptr Iterator)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Iterator
it
    Ptr Iterator
other' <- Iterator -> IO (Ptr Iterator)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Iterator
other
    C_IteratorCopyFunction
gst_iterator_push Ptr Iterator
it' Ptr Iterator
other'
    IteratorResyncFunction
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Iterator
it
    IteratorResyncFunction
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Iterator
other
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IteratorPushMethodInfo
instance (signature ~ (Iterator -> m ()), MonadIO m) => O.OverloadedMethod IteratorPushMethodInfo Iterator signature where
    overloadedMethod = iteratorPush

instance O.OverloadedMethodInfo IteratorPushMethodInfo Iterator where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Iterator.iteratorPush",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Iterator.html#v:iteratorPush"
        })


#endif

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

foreign import ccall "gst_iterator_resync" gst_iterator_resync :: 
    Ptr Iterator ->                         -- it : TInterface (Name {namespace = "Gst", name = "Iterator"})
    IO ()

-- | Resync the iterator. this function is mostly called
-- after 'GI.Gst.Structs.Iterator.iteratorNext' returned 'GI.Gst.Enums.IteratorResultResync'.
-- 
-- When an iterator was pushed on /@it@/, it will automatically be popped again
-- with this function.
-- 
-- MT safe.
iteratorResync ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Iterator
    -- ^ /@it@/: The t'GI.Gst.Structs.Iterator.Iterator' to resync
    -> m ()
iteratorResync :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Iterator -> m ()
iteratorResync Iterator
it = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Iterator
it' <- Iterator -> IO (Ptr Iterator)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Iterator
it
    Ptr Iterator -> IO ()
gst_iterator_resync Ptr Iterator
it'
    IteratorResyncFunction
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Iterator
it
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IteratorResyncMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod IteratorResyncMethodInfo Iterator signature where
    overloadedMethod = iteratorResync

instance O.OverloadedMethodInfo IteratorResyncMethodInfo Iterator where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Iterator.iteratorResync",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Iterator.html#v:iteratorResync"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveIteratorMethod (t :: Symbol) (o :: *) :: * where
    ResolveIteratorMethod "copy" o = IteratorCopyMethodInfo
    ResolveIteratorMethod "filter" o = IteratorFilterMethodInfo
    ResolveIteratorMethod "findCustom" o = IteratorFindCustomMethodInfo
    ResolveIteratorMethod "fold" o = IteratorFoldMethodInfo
    ResolveIteratorMethod "foreach" o = IteratorForeachMethodInfo
    ResolveIteratorMethod "free" o = IteratorFreeMethodInfo
    ResolveIteratorMethod "next" o = IteratorNextMethodInfo
    ResolveIteratorMethod "push" o = IteratorPushMethodInfo
    ResolveIteratorMethod "resync" o = IteratorResyncMethodInfo
    ResolveIteratorMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveIteratorMethod t Iterator, O.OverloadedMethod info Iterator p) => OL.IsLabel t (Iterator -> 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 ~ ResolveIteratorMethod t Iterator, O.OverloadedMethod info Iterator p, R.HasField t Iterator p) => R.HasField t Iterator p where
    getField = O.overloadedMethod @info

#endif

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

#endif