{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- /No description available in the introspection data./

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

module GI.Gst.Structs.TocEntry
    ( 

-- * Exported types
    TocEntry(..)                            ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [appendSubEntry]("GI.Gst.Structs.TocEntry#g:method:appendSubEntry"), [isAlternative]("GI.Gst.Structs.TocEntry#g:method:isAlternative"), [isSequence]("GI.Gst.Structs.TocEntry#g:method:isSequence"), [mergeTags]("GI.Gst.Structs.TocEntry#g:method:mergeTags").
-- 
-- ==== Getters
-- [getEntryType]("GI.Gst.Structs.TocEntry#g:method:getEntryType"), [getLoop]("GI.Gst.Structs.TocEntry#g:method:getLoop"), [getParent]("GI.Gst.Structs.TocEntry#g:method:getParent"), [getStartStopTimes]("GI.Gst.Structs.TocEntry#g:method:getStartStopTimes"), [getSubEntries]("GI.Gst.Structs.TocEntry#g:method:getSubEntries"), [getTags]("GI.Gst.Structs.TocEntry#g:method:getTags"), [getToc]("GI.Gst.Structs.TocEntry#g:method:getToc"), [getUid]("GI.Gst.Structs.TocEntry#g:method:getUid").
-- 
-- ==== Setters
-- [setLoop]("GI.Gst.Structs.TocEntry#g:method:setLoop"), [setStartStopTimes]("GI.Gst.Structs.TocEntry#g:method:setStartStopTimes"), [setTags]("GI.Gst.Structs.TocEntry#g:method:setTags").

#if defined(ENABLE_OVERLOADING)
    ResolveTocEntryMethod                   ,
#endif

-- ** appendSubEntry #method:appendSubEntry#

#if defined(ENABLE_OVERLOADING)
    TocEntryAppendSubEntryMethodInfo        ,
#endif
    tocEntryAppendSubEntry                  ,


-- ** getEntryType #method:getEntryType#

#if defined(ENABLE_OVERLOADING)
    TocEntryGetEntryTypeMethodInfo          ,
#endif
    tocEntryGetEntryType                    ,


-- ** getLoop #method:getLoop#

#if defined(ENABLE_OVERLOADING)
    TocEntryGetLoopMethodInfo               ,
#endif
    tocEntryGetLoop                         ,


-- ** getParent #method:getParent#

#if defined(ENABLE_OVERLOADING)
    TocEntryGetParentMethodInfo             ,
#endif
    tocEntryGetParent                       ,


-- ** getStartStopTimes #method:getStartStopTimes#

#if defined(ENABLE_OVERLOADING)
    TocEntryGetStartStopTimesMethodInfo     ,
#endif
    tocEntryGetStartStopTimes               ,


-- ** getSubEntries #method:getSubEntries#

#if defined(ENABLE_OVERLOADING)
    TocEntryGetSubEntriesMethodInfo         ,
#endif
    tocEntryGetSubEntries                   ,


-- ** getTags #method:getTags#

#if defined(ENABLE_OVERLOADING)
    TocEntryGetTagsMethodInfo               ,
#endif
    tocEntryGetTags                         ,


-- ** getToc #method:getToc#

#if defined(ENABLE_OVERLOADING)
    TocEntryGetTocMethodInfo                ,
#endif
    tocEntryGetToc                          ,


-- ** getUid #method:getUid#

#if defined(ENABLE_OVERLOADING)
    TocEntryGetUidMethodInfo                ,
#endif
    tocEntryGetUid                          ,


-- ** isAlternative #method:isAlternative#

#if defined(ENABLE_OVERLOADING)
    TocEntryIsAlternativeMethodInfo         ,
#endif
    tocEntryIsAlternative                   ,


-- ** isSequence #method:isSequence#

#if defined(ENABLE_OVERLOADING)
    TocEntryIsSequenceMethodInfo            ,
#endif
    tocEntryIsSequence                      ,


-- ** mergeTags #method:mergeTags#

#if defined(ENABLE_OVERLOADING)
    TocEntryMergeTagsMethodInfo             ,
#endif
    tocEntryMergeTags                       ,


-- ** new #method:new#

    tocEntryNew                             ,


-- ** setLoop #method:setLoop#

#if defined(ENABLE_OVERLOADING)
    TocEntrySetLoopMethodInfo               ,
#endif
    tocEntrySetLoop                         ,


-- ** setStartStopTimes #method:setStartStopTimes#

#if defined(ENABLE_OVERLOADING)
    TocEntrySetStartStopTimesMethodInfo     ,
#endif
    tocEntrySetStartStopTimes               ,


-- ** setTags #method:setTags#

#if defined(ENABLE_OVERLOADING)
    TocEntrySetTagsMethodInfo               ,
#endif
    tocEntrySetTags                         ,




    ) 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 {-# SOURCE #-} qualified GI.Gst.Enums as Gst.Enums
import {-# SOURCE #-} qualified GI.Gst.Structs.TagList as Gst.TagList
import {-# SOURCE #-} qualified GI.Gst.Structs.Toc as Gst.Toc

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

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

foreign import ccall "gst_toc_entry_get_type" c_gst_toc_entry_get_type :: 
    IO GType

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

instance B.Types.TypedObject TocEntry where
    glibType :: IO GType
glibType = IO GType
c_gst_toc_entry_get_type

instance B.Types.GBoxed TocEntry

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


#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList TocEntry
type instance O.AttributeList TocEntry = TocEntryAttributeList
type TocEntryAttributeList = ('[ ] :: [(Symbol, *)])
#endif

-- method TocEntry::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "type"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TocEntryType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "entry type." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "uid"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "unique ID (UID) in the whole TOC."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "TocEntry" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_toc_entry_new" gst_toc_entry_new :: 
    CInt ->                                 -- type : TInterface (Name {namespace = "Gst", name = "TocEntryType"})
    CString ->                              -- uid : TBasicType TUTF8
    IO (Ptr TocEntry)

-- | Create new t'GI.Gst.Structs.TocEntry.TocEntry' structure.
tocEntryNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Enums.TocEntryType
    -- ^ /@type@/: entry type.
    -> T.Text
    -- ^ /@uid@/: unique ID (UID) in the whole TOC.
    -> m TocEntry
    -- ^ __Returns:__ newly allocated t'GI.Gst.Structs.TocEntry.TocEntry' structure, free it with @/gst_toc_entry_unref()/@.
tocEntryNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TocEntryType -> Text -> m TocEntry
tocEntryNew TocEntryType
type_ Text
uid = IO TocEntry -> m TocEntry
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TocEntry -> m TocEntry) -> IO TocEntry -> m TocEntry
forall a b. (a -> b) -> a -> b
$ do
    let type_' :: CInt
type_' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (TocEntryType -> Int) -> TocEntryType -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TocEntryType -> Int
forall a. Enum a => a -> Int
fromEnum) TocEntryType
type_
    CString
uid' <- Text -> IO CString
textToCString Text
uid
    Ptr TocEntry
result <- CInt -> CString -> IO (Ptr TocEntry)
gst_toc_entry_new CInt
type_' CString
uid'
    Text -> Ptr TocEntry -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"tocEntryNew" Ptr TocEntry
result
    TocEntry
result' <- ((ManagedPtr TocEntry -> TocEntry) -> Ptr TocEntry -> IO TocEntry
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr TocEntry -> TocEntry
TocEntry) Ptr TocEntry
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
uid'
    TocEntry -> IO TocEntry
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TocEntry
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method TocEntry::append_sub_entry
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TocEntry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GstTocEntry instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "subentry"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TocEntry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GstTocEntry" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_toc_entry_append_sub_entry" gst_toc_entry_append_sub_entry :: 
    Ptr TocEntry ->                         -- entry : TInterface (Name {namespace = "Gst", name = "TocEntry"})
    Ptr TocEntry ->                         -- subentry : TInterface (Name {namespace = "Gst", name = "TocEntry"})
    IO ()

-- | Appends the t'GI.Gst.Structs.TocEntry.TocEntry' /@subentry@/ to /@entry@/.
tocEntryAppendSubEntry ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TocEntry
    -- ^ /@entry@/: A t'GI.Gst.Structs.TocEntry.TocEntry' instance
    -> TocEntry
    -- ^ /@subentry@/: A t'GI.Gst.Structs.TocEntry.TocEntry'
    -> m ()
tocEntryAppendSubEntry :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TocEntry -> TocEntry -> m ()
tocEntryAppendSubEntry TocEntry
entry TocEntry
subentry = 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 TocEntry
entry' <- TocEntry -> IO (Ptr TocEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TocEntry
entry
    Ptr TocEntry
subentry' <- TocEntry -> IO (Ptr TocEntry)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed TocEntry
subentry
    Ptr TocEntry -> Ptr TocEntry -> IO ()
gst_toc_entry_append_sub_entry Ptr TocEntry
entry' Ptr TocEntry
subentry'
    TocEntry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TocEntry
entry
    TocEntry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TocEntry
subentry
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TocEntryAppendSubEntryMethodInfo
instance (signature ~ (TocEntry -> m ()), MonadIO m) => O.OverloadedMethod TocEntryAppendSubEntryMethodInfo TocEntry signature where
    overloadedMethod = tocEntryAppendSubEntry

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


#endif

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

foreign import ccall "gst_toc_entry_get_entry_type" gst_toc_entry_get_entry_type :: 
    Ptr TocEntry ->                         -- entry : TInterface (Name {namespace = "Gst", name = "TocEntry"})
    IO CInt

-- | /No description available in the introspection data./
tocEntryGetEntryType ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TocEntry
    -- ^ /@entry@/: a t'GI.Gst.Structs.TocEntry.TocEntry'
    -> m Gst.Enums.TocEntryType
    -- ^ __Returns:__ /@entry@/\'s entry type
tocEntryGetEntryType :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TocEntry -> m TocEntryType
tocEntryGetEntryType TocEntry
entry = IO TocEntryType -> m TocEntryType
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TocEntryType -> m TocEntryType)
-> IO TocEntryType -> m TocEntryType
forall a b. (a -> b) -> a -> b
$ do
    Ptr TocEntry
entry' <- TocEntry -> IO (Ptr TocEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TocEntry
entry
    CInt
result <- Ptr TocEntry -> IO CInt
gst_toc_entry_get_entry_type Ptr TocEntry
entry'
    let result' :: TocEntryType
result' = (Int -> TocEntryType
forall a. Enum a => Int -> a
toEnum (Int -> TocEntryType) -> (CInt -> Int) -> CInt -> TocEntryType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CInt
result
    TocEntry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TocEntry
entry
    TocEntryType -> IO TocEntryType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TocEntryType
result'

#if defined(ENABLE_OVERLOADING)
data TocEntryGetEntryTypeMethodInfo
instance (signature ~ (m Gst.Enums.TocEntryType), MonadIO m) => O.OverloadedMethod TocEntryGetEntryTypeMethodInfo TocEntry signature where
    overloadedMethod = tocEntryGetEntryType

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


#endif

-- method TocEntry::get_loop
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TocEntry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GstTocEntry to get values from."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "loop_type"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TocLoopType" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the storage for the loop_type\n            value, leave %NULL if not need."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "repeat_count"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the storage for the repeat_count\n               value, leave %NULL if not need."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_toc_entry_get_loop" gst_toc_entry_get_loop :: 
    Ptr TocEntry ->                         -- entry : TInterface (Name {namespace = "Gst", name = "TocEntry"})
    Ptr CUInt ->                            -- loop_type : TInterface (Name {namespace = "Gst", name = "TocLoopType"})
    Ptr Int32 ->                            -- repeat_count : TBasicType TInt
    IO CInt

-- | Get /@loopType@/ and /@repeatCount@/ values from the /@entry@/ and write them into
-- appropriate storages. Loops are e.g. used by sampled instruments. GStreamer
-- is not automatically applying the loop. The application can process this
-- meta data and use it e.g. to send a seek-event to loop a section.
-- 
-- /Since: 1.4/
tocEntryGetLoop ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TocEntry
    -- ^ /@entry@/: t'GI.Gst.Structs.TocEntry.TocEntry' to get values from.
    -> m ((Bool, Gst.Enums.TocLoopType, Int32))
    -- ^ __Returns:__ 'P.True' if all non-'P.Nothing' storage pointers were filled with appropriate
    -- values, 'P.False' otherwise.
tocEntryGetLoop :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TocEntry -> m (Bool, TocLoopType, Int32)
tocEntryGetLoop TocEntry
entry = IO (Bool, TocLoopType, Int32) -> m (Bool, TocLoopType, Int32)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, TocLoopType, Int32) -> m (Bool, TocLoopType, Int32))
-> IO (Bool, TocLoopType, Int32) -> m (Bool, TocLoopType, Int32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr TocEntry
entry' <- TocEntry -> IO (Ptr TocEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TocEntry
entry
    Ptr CUInt
loopType <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
    Ptr Int32
repeatCount <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    CInt
result <- Ptr TocEntry -> Ptr CUInt -> Ptr Int32 -> IO CInt
gst_toc_entry_get_loop Ptr TocEntry
entry' Ptr CUInt
loopType Ptr Int32
repeatCount
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CUInt
loopType' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
loopType
    let loopType'' :: TocLoopType
loopType'' = (Int -> TocLoopType
forall a. Enum a => Int -> a
toEnum (Int -> TocLoopType) -> (CUInt -> Int) -> CUInt -> TocLoopType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
loopType'
    Int32
repeatCount' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
repeatCount
    TocEntry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TocEntry
entry
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
loopType
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
repeatCount
    (Bool, TocLoopType, Int32) -> IO (Bool, TocLoopType, Int32)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', TocLoopType
loopType'', Int32
repeatCount')

#if defined(ENABLE_OVERLOADING)
data TocEntryGetLoopMethodInfo
instance (signature ~ (m ((Bool, Gst.Enums.TocLoopType, Int32))), MonadIO m) => O.OverloadedMethod TocEntryGetLoopMethodInfo TocEntry signature where
    overloadedMethod = tocEntryGetLoop

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


#endif

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

foreign import ccall "gst_toc_entry_get_parent" gst_toc_entry_get_parent :: 
    Ptr TocEntry ->                         -- entry : TInterface (Name {namespace = "Gst", name = "TocEntry"})
    IO (Ptr TocEntry)

-- | Gets the parent t'GI.Gst.Structs.TocEntry.TocEntry' of /@entry@/.
tocEntryGetParent ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TocEntry
    -- ^ /@entry@/: A t'GI.Gst.Structs.TocEntry.TocEntry' instance
    -> m (Maybe TocEntry)
    -- ^ __Returns:__ The parent t'GI.Gst.Structs.TocEntry.TocEntry' of /@entry@/
tocEntryGetParent :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TocEntry -> m (Maybe TocEntry)
tocEntryGetParent TocEntry
entry = IO (Maybe TocEntry) -> m (Maybe TocEntry)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe TocEntry) -> m (Maybe TocEntry))
-> IO (Maybe TocEntry) -> m (Maybe TocEntry)
forall a b. (a -> b) -> a -> b
$ do
    Ptr TocEntry
entry' <- TocEntry -> IO (Ptr TocEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TocEntry
entry
    Ptr TocEntry
result <- Ptr TocEntry -> IO (Ptr TocEntry)
gst_toc_entry_get_parent Ptr TocEntry
entry'
    Maybe TocEntry
maybeResult <- Ptr TocEntry
-> (Ptr TocEntry -> IO TocEntry) -> IO (Maybe TocEntry)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr TocEntry
result ((Ptr TocEntry -> IO TocEntry) -> IO (Maybe TocEntry))
-> (Ptr TocEntry -> IO TocEntry) -> IO (Maybe TocEntry)
forall a b. (a -> b) -> a -> b
$ \Ptr TocEntry
result' -> do
        TocEntry
result'' <- ((ManagedPtr TocEntry -> TocEntry) -> Ptr TocEntry -> IO TocEntry
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr TocEntry -> TocEntry
TocEntry) Ptr TocEntry
result'
        TocEntry -> IO TocEntry
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TocEntry
result''
    TocEntry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TocEntry
entry
    Maybe TocEntry -> IO (Maybe TocEntry)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TocEntry
maybeResult

#if defined(ENABLE_OVERLOADING)
data TocEntryGetParentMethodInfo
instance (signature ~ (m (Maybe TocEntry)), MonadIO m) => O.OverloadedMethod TocEntryGetParentMethodInfo TocEntry signature where
    overloadedMethod = tocEntryGetParent

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


#endif

-- method TocEntry::get_start_stop_times
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TocEntry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GstTocEntry to get values from."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "start"
--           , argType = TBasicType TInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the storage for the start value, leave\n  %NULL if not need."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "stop"
--           , argType = TBasicType TInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the storage for the stop value, leave\n  %NULL if not need."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_toc_entry_get_start_stop_times" gst_toc_entry_get_start_stop_times :: 
    Ptr TocEntry ->                         -- entry : TInterface (Name {namespace = "Gst", name = "TocEntry"})
    Ptr Int64 ->                            -- start : TBasicType TInt64
    Ptr Int64 ->                            -- stop : TBasicType TInt64
    IO CInt

-- | Get /@start@/ and /@stop@/ values from the /@entry@/ and write them into appropriate
-- storages.
tocEntryGetStartStopTimes ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TocEntry
    -- ^ /@entry@/: t'GI.Gst.Structs.TocEntry.TocEntry' to get values from.
    -> m ((Bool, Int64, Int64))
    -- ^ __Returns:__ 'P.True' if all non-'P.Nothing' storage pointers were filled with appropriate
    -- values, 'P.False' otherwise.
tocEntryGetStartStopTimes :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TocEntry -> m (Bool, Int64, Int64)
tocEntryGetStartStopTimes TocEntry
entry = IO (Bool, Int64, Int64) -> m (Bool, Int64, Int64)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Int64, Int64) -> m (Bool, Int64, Int64))
-> IO (Bool, Int64, Int64) -> m (Bool, Int64, Int64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr TocEntry
entry' <- TocEntry -> IO (Ptr TocEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TocEntry
entry
    Ptr Int64
start <- IO (Ptr Int64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int64)
    Ptr Int64
stop <- IO (Ptr Int64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int64)
    CInt
result <- Ptr TocEntry -> Ptr Int64 -> Ptr Int64 -> IO CInt
gst_toc_entry_get_start_stop_times Ptr TocEntry
entry' Ptr Int64
start Ptr Int64
stop
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Int64
start' <- Ptr Int64 -> IO Int64
forall a. Storable a => Ptr a -> IO a
peek Ptr Int64
start
    Int64
stop' <- Ptr Int64 -> IO Int64
forall a. Storable a => Ptr a -> IO a
peek Ptr Int64
stop
    TocEntry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TocEntry
entry
    Ptr Int64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int64
start
    Ptr Int64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int64
stop
    (Bool, Int64, Int64) -> IO (Bool, Int64, Int64)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Int64
start', Int64
stop')

#if defined(ENABLE_OVERLOADING)
data TocEntryGetStartStopTimesMethodInfo
instance (signature ~ (m ((Bool, Int64, Int64))), MonadIO m) => O.OverloadedMethod TocEntryGetStartStopTimesMethodInfo TocEntry signature where
    overloadedMethod = tocEntryGetStartStopTimes

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


#endif

-- method TocEntry::get_sub_entries
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TocEntry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GstTocEntry instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList
--                  (TInterface Name { namespace = "Gst" , name = "TocEntry" }))
-- throws : False
-- Skip return : False

foreign import ccall "gst_toc_entry_get_sub_entries" gst_toc_entry_get_sub_entries :: 
    Ptr TocEntry ->                         -- entry : TInterface (Name {namespace = "Gst", name = "TocEntry"})
    IO (Ptr (GList (Ptr TocEntry)))

-- | Gets the sub-entries of /@entry@/.
tocEntryGetSubEntries ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TocEntry
    -- ^ /@entry@/: A t'GI.Gst.Structs.TocEntry.TocEntry' instance
    -> m [TocEntry]
    -- ^ __Returns:__ A t'GI.GLib.Structs.List.List' of t'GI.Gst.Structs.TocEntry.TocEntry' of /@entry@/
tocEntryGetSubEntries :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TocEntry -> m [TocEntry]
tocEntryGetSubEntries TocEntry
entry = IO [TocEntry] -> m [TocEntry]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [TocEntry] -> m [TocEntry]) -> IO [TocEntry] -> m [TocEntry]
forall a b. (a -> b) -> a -> b
$ do
    Ptr TocEntry
entry' <- TocEntry -> IO (Ptr TocEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TocEntry
entry
    Ptr (GList (Ptr TocEntry))
result <- Ptr TocEntry -> IO (Ptr (GList (Ptr TocEntry)))
gst_toc_entry_get_sub_entries Ptr TocEntry
entry'
    [Ptr TocEntry]
result' <- Ptr (GList (Ptr TocEntry)) -> IO [Ptr TocEntry]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr TocEntry))
result
    [TocEntry]
result'' <- (Ptr TocEntry -> IO TocEntry) -> [Ptr TocEntry] -> IO [TocEntry]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ManagedPtr TocEntry -> TocEntry) -> Ptr TocEntry -> IO TocEntry
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr TocEntry -> TocEntry
TocEntry) [Ptr TocEntry]
result'
    TocEntry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TocEntry
entry
    [TocEntry] -> IO [TocEntry]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [TocEntry]
result''

#if defined(ENABLE_OVERLOADING)
data TocEntryGetSubEntriesMethodInfo
instance (signature ~ (m [TocEntry]), MonadIO m) => O.OverloadedMethod TocEntryGetSubEntriesMethodInfo TocEntry signature where
    overloadedMethod = tocEntryGetSubEntries

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


#endif

-- method TocEntry::get_tags
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TocEntry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GstTocEntry instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "TagList" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_toc_entry_get_tags" gst_toc_entry_get_tags :: 
    Ptr TocEntry ->                         -- entry : TInterface (Name {namespace = "Gst", name = "TocEntry"})
    IO (Ptr Gst.TagList.TagList)

-- | Gets the tags for /@entry@/.
tocEntryGetTags ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TocEntry
    -- ^ /@entry@/: A t'GI.Gst.Structs.TocEntry.TocEntry' instance
    -> m Gst.TagList.TagList
    -- ^ __Returns:__ A t'GI.Gst.Structs.TagList.TagList' for /@entry@/
tocEntryGetTags :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TocEntry -> m TagList
tocEntryGetTags TocEntry
entry = IO TagList -> m TagList
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TagList -> m TagList) -> IO TagList -> m TagList
forall a b. (a -> b) -> a -> b
$ do
    Ptr TocEntry
entry' <- TocEntry -> IO (Ptr TocEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TocEntry
entry
    Ptr TagList
result <- Ptr TocEntry -> IO (Ptr TagList)
gst_toc_entry_get_tags Ptr TocEntry
entry'
    Text -> Ptr TagList -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"tocEntryGetTags" Ptr TagList
result
    TagList
result' <- ((ManagedPtr TagList -> TagList) -> Ptr TagList -> IO TagList
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr TagList -> TagList
Gst.TagList.TagList) Ptr TagList
result
    TocEntry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TocEntry
entry
    TagList -> IO TagList
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TagList
result'

#if defined(ENABLE_OVERLOADING)
data TocEntryGetTagsMethodInfo
instance (signature ~ (m Gst.TagList.TagList), MonadIO m) => O.OverloadedMethod TocEntryGetTagsMethodInfo TocEntry signature where
    overloadedMethod = tocEntryGetTags

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


#endif

-- method TocEntry::get_toc
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TocEntry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GstTocEntry instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Toc" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_toc_entry_get_toc" gst_toc_entry_get_toc :: 
    Ptr TocEntry ->                         -- entry : TInterface (Name {namespace = "Gst", name = "TocEntry"})
    IO (Ptr Gst.Toc.Toc)

-- | Gets the parent t'GI.Gst.Structs.Toc.Toc' of /@entry@/.
tocEntryGetToc ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TocEntry
    -- ^ /@entry@/: A t'GI.Gst.Structs.TocEntry.TocEntry' instance
    -> m Gst.Toc.Toc
    -- ^ __Returns:__ The parent t'GI.Gst.Structs.Toc.Toc' of /@entry@/
tocEntryGetToc :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TocEntry -> m Toc
tocEntryGetToc TocEntry
entry = IO Toc -> m Toc
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Toc -> m Toc) -> IO Toc -> m Toc
forall a b. (a -> b) -> a -> b
$ do
    Ptr TocEntry
entry' <- TocEntry -> IO (Ptr TocEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TocEntry
entry
    Ptr Toc
result <- Ptr TocEntry -> IO (Ptr Toc)
gst_toc_entry_get_toc Ptr TocEntry
entry'
    Text -> Ptr Toc -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"tocEntryGetToc" Ptr Toc
result
    Toc
result' <- ((ManagedPtr Toc -> Toc) -> Ptr Toc -> IO Toc
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Toc -> Toc
Gst.Toc.Toc) Ptr Toc
result
    TocEntry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TocEntry
entry
    Toc -> IO Toc
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Toc
result'

#if defined(ENABLE_OVERLOADING)
data TocEntryGetTocMethodInfo
instance (signature ~ (m Gst.Toc.Toc), MonadIO m) => O.OverloadedMethod TocEntryGetTocMethodInfo TocEntry signature where
    overloadedMethod = tocEntryGetToc

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


#endif

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

foreign import ccall "gst_toc_entry_get_uid" gst_toc_entry_get_uid :: 
    Ptr TocEntry ->                         -- entry : TInterface (Name {namespace = "Gst", name = "TocEntry"})
    IO CString

-- | Gets the UID of /@entry@/.
tocEntryGetUid ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TocEntry
    -- ^ /@entry@/: A t'GI.Gst.Structs.TocEntry.TocEntry' instance
    -> m T.Text
    -- ^ __Returns:__ The UID of /@entry@/
tocEntryGetUid :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TocEntry -> m Text
tocEntryGetUid TocEntry
entry = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr TocEntry
entry' <- TocEntry -> IO (Ptr TocEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TocEntry
entry
    CString
result <- Ptr TocEntry -> IO CString
gst_toc_entry_get_uid Ptr TocEntry
entry'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"tocEntryGetUid" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    TocEntry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TocEntry
entry
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data TocEntryGetUidMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod TocEntryGetUidMethodInfo TocEntry signature where
    overloadedMethod = tocEntryGetUid

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


#endif

-- method TocEntry::is_alternative
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TocEntry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstTocEntry" , 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_toc_entry_is_alternative" gst_toc_entry_is_alternative :: 
    Ptr TocEntry ->                         -- entry : TInterface (Name {namespace = "Gst", name = "TocEntry"})
    IO CInt

-- | /No description available in the introspection data./
tocEntryIsAlternative ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TocEntry
    -- ^ /@entry@/: a t'GI.Gst.Structs.TocEntry.TocEntry'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@entry@/\'s type is an alternative type, otherwise 'P.False'
tocEntryIsAlternative :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TocEntry -> m Bool
tocEntryIsAlternative TocEntry
entry = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr TocEntry
entry' <- TocEntry -> IO (Ptr TocEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TocEntry
entry
    CInt
result <- Ptr TocEntry -> IO CInt
gst_toc_entry_is_alternative Ptr TocEntry
entry'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    TocEntry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TocEntry
entry
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data TocEntryIsAlternativeMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod TocEntryIsAlternativeMethodInfo TocEntry signature where
    overloadedMethod = tocEntryIsAlternative

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


#endif

-- method TocEntry::is_sequence
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TocEntry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstTocEntry" , 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_toc_entry_is_sequence" gst_toc_entry_is_sequence :: 
    Ptr TocEntry ->                         -- entry : TInterface (Name {namespace = "Gst", name = "TocEntry"})
    IO CInt

-- | /No description available in the introspection data./
tocEntryIsSequence ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TocEntry
    -- ^ /@entry@/: a t'GI.Gst.Structs.TocEntry.TocEntry'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@entry@/\'s type is a sequence type, otherwise 'P.False'
tocEntryIsSequence :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TocEntry -> m Bool
tocEntryIsSequence TocEntry
entry = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr TocEntry
entry' <- TocEntry -> IO (Ptr TocEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TocEntry
entry
    CInt
result <- Ptr TocEntry -> IO CInt
gst_toc_entry_is_sequence Ptr TocEntry
entry'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    TocEntry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TocEntry
entry
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data TocEntryIsSequenceMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod TocEntryIsSequenceMethodInfo TocEntry signature where
    overloadedMethod = tocEntryIsSequence

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


#endif

-- method TocEntry::merge_tags
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TocEntry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GstTocEntry instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tags"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagList" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GstTagList or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mode"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagMergeMode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GstTagMergeMode" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_toc_entry_merge_tags" gst_toc_entry_merge_tags :: 
    Ptr TocEntry ->                         -- entry : TInterface (Name {namespace = "Gst", name = "TocEntry"})
    Ptr Gst.TagList.TagList ->              -- tags : TInterface (Name {namespace = "Gst", name = "TagList"})
    CUInt ->                                -- mode : TInterface (Name {namespace = "Gst", name = "TagMergeMode"})
    IO ()

-- | Merge /@tags@/ into the existing tags of /@entry@/ using /@mode@/.
tocEntryMergeTags ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TocEntry
    -- ^ /@entry@/: A t'GI.Gst.Structs.TocEntry.TocEntry' instance
    -> Maybe (Gst.TagList.TagList)
    -- ^ /@tags@/: A t'GI.Gst.Structs.TagList.TagList' or 'P.Nothing'
    -> Gst.Enums.TagMergeMode
    -- ^ /@mode@/: A t'GI.Gst.Enums.TagMergeMode'
    -> m ()
tocEntryMergeTags :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TocEntry -> Maybe TagList -> TagMergeMode -> m ()
tocEntryMergeTags TocEntry
entry Maybe TagList
tags TagMergeMode
mode = 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 TocEntry
entry' <- TocEntry -> IO (Ptr TocEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TocEntry
entry
    Ptr TagList
maybeTags <- case Maybe TagList
tags of
        Maybe TagList
Nothing -> Ptr TagList -> IO (Ptr TagList)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TagList
forall a. Ptr a
nullPtr
        Just TagList
jTags -> do
            Ptr TagList
jTags' <- TagList -> IO (Ptr TagList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TagList
jTags
            Ptr TagList -> IO (Ptr TagList)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TagList
jTags'
    let mode' :: CUInt
mode' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (TagMergeMode -> Int) -> TagMergeMode -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TagMergeMode -> Int
forall a. Enum a => a -> Int
fromEnum) TagMergeMode
mode
    Ptr TocEntry -> Ptr TagList -> CUInt -> IO ()
gst_toc_entry_merge_tags Ptr TocEntry
entry' Ptr TagList
maybeTags CUInt
mode'
    TocEntry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TocEntry
entry
    Maybe TagList -> (TagList -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe TagList
tags TagList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TocEntryMergeTagsMethodInfo
instance (signature ~ (Maybe (Gst.TagList.TagList) -> Gst.Enums.TagMergeMode -> m ()), MonadIO m) => O.OverloadedMethod TocEntryMergeTagsMethodInfo TocEntry signature where
    overloadedMethod = tocEntryMergeTags

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


#endif

-- method TocEntry::set_loop
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TocEntry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GstTocEntry to set values."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "loop_type"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TocLoopType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "loop_type value to set."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "repeat_count"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "repeat_count value to set."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_toc_entry_set_loop" gst_toc_entry_set_loop :: 
    Ptr TocEntry ->                         -- entry : TInterface (Name {namespace = "Gst", name = "TocEntry"})
    CUInt ->                                -- loop_type : TInterface (Name {namespace = "Gst", name = "TocLoopType"})
    Int32 ->                                -- repeat_count : TBasicType TInt
    IO ()

-- | Set /@loopType@/ and /@repeatCount@/ values for the /@entry@/.
-- 
-- /Since: 1.4/
tocEntrySetLoop ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TocEntry
    -- ^ /@entry@/: t'GI.Gst.Structs.TocEntry.TocEntry' to set values.
    -> Gst.Enums.TocLoopType
    -- ^ /@loopType@/: loop_type value to set.
    -> Int32
    -- ^ /@repeatCount@/: repeat_count value to set.
    -> m ()
tocEntrySetLoop :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TocEntry -> TocLoopType -> Int32 -> m ()
tocEntrySetLoop TocEntry
entry TocLoopType
loopType Int32
repeatCount = 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 TocEntry
entry' <- TocEntry -> IO (Ptr TocEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TocEntry
entry
    let loopType' :: CUInt
loopType' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (TocLoopType -> Int) -> TocLoopType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TocLoopType -> Int
forall a. Enum a => a -> Int
fromEnum) TocLoopType
loopType
    Ptr TocEntry -> CUInt -> Int32 -> IO ()
gst_toc_entry_set_loop Ptr TocEntry
entry' CUInt
loopType' Int32
repeatCount
    TocEntry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TocEntry
entry
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TocEntrySetLoopMethodInfo
instance (signature ~ (Gst.Enums.TocLoopType -> Int32 -> m ()), MonadIO m) => O.OverloadedMethod TocEntrySetLoopMethodInfo TocEntry signature where
    overloadedMethod = tocEntrySetLoop

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


#endif

-- method TocEntry::set_start_stop_times
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TocEntry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GstTocEntry to set values."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "start"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "start value to set."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "stop"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "stop value to set." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_toc_entry_set_start_stop_times" gst_toc_entry_set_start_stop_times :: 
    Ptr TocEntry ->                         -- entry : TInterface (Name {namespace = "Gst", name = "TocEntry"})
    Int64 ->                                -- start : TBasicType TInt64
    Int64 ->                                -- stop : TBasicType TInt64
    IO ()

-- | Set /@start@/ and /@stop@/ values for the /@entry@/.
tocEntrySetStartStopTimes ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TocEntry
    -- ^ /@entry@/: t'GI.Gst.Structs.TocEntry.TocEntry' to set values.
    -> Int64
    -- ^ /@start@/: start value to set.
    -> Int64
    -- ^ /@stop@/: stop value to set.
    -> m ()
tocEntrySetStartStopTimes :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TocEntry -> Int64 -> Int64 -> m ()
tocEntrySetStartStopTimes TocEntry
entry Int64
start Int64
stop = 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 TocEntry
entry' <- TocEntry -> IO (Ptr TocEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TocEntry
entry
    Ptr TocEntry -> Int64 -> Int64 -> IO ()
gst_toc_entry_set_start_stop_times Ptr TocEntry
entry' Int64
start Int64
stop
    TocEntry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TocEntry
entry
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TocEntrySetStartStopTimesMethodInfo
instance (signature ~ (Int64 -> Int64 -> m ()), MonadIO m) => O.OverloadedMethod TocEntrySetStartStopTimesMethodInfo TocEntry signature where
    overloadedMethod = tocEntrySetStartStopTimes

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


#endif

-- method TocEntry::set_tags
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TocEntry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GstTocEntry instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tags"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagList" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GstTagList or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_toc_entry_set_tags" gst_toc_entry_set_tags :: 
    Ptr TocEntry ->                         -- entry : TInterface (Name {namespace = "Gst", name = "TocEntry"})
    Ptr Gst.TagList.TagList ->              -- tags : TInterface (Name {namespace = "Gst", name = "TagList"})
    IO ()

-- | Set a t'GI.Gst.Structs.TagList.TagList' with tags for the complete /@entry@/.
tocEntrySetTags ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TocEntry
    -- ^ /@entry@/: A t'GI.Gst.Structs.TocEntry.TocEntry' instance
    -> Maybe (Gst.TagList.TagList)
    -- ^ /@tags@/: A t'GI.Gst.Structs.TagList.TagList' or 'P.Nothing'
    -> m ()
tocEntrySetTags :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TocEntry -> Maybe TagList -> m ()
tocEntrySetTags TocEntry
entry Maybe TagList
tags = 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 TocEntry
entry' <- TocEntry -> IO (Ptr TocEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TocEntry
entry
    Ptr TagList
maybeTags <- case Maybe TagList
tags of
        Maybe TagList
Nothing -> Ptr TagList -> IO (Ptr TagList)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TagList
forall a. Ptr a
nullPtr
        Just TagList
jTags -> do
            Ptr TagList
jTags' <- TagList -> IO (Ptr TagList)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed TagList
jTags
            Ptr TagList -> IO (Ptr TagList)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TagList
jTags'
    Ptr TocEntry -> Ptr TagList -> IO ()
gst_toc_entry_set_tags Ptr TocEntry
entry' Ptr TagList
maybeTags
    TocEntry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TocEntry
entry
    Maybe TagList -> (TagList -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe TagList
tags TagList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TocEntrySetTagsMethodInfo
instance (signature ~ (Maybe (Gst.TagList.TagList) -> m ()), MonadIO m) => O.OverloadedMethod TocEntrySetTagsMethodInfo TocEntry signature where
    overloadedMethod = tocEntrySetTags

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


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveTocEntryMethod (t :: Symbol) (o :: *) :: * where
    ResolveTocEntryMethod "appendSubEntry" o = TocEntryAppendSubEntryMethodInfo
    ResolveTocEntryMethod "isAlternative" o = TocEntryIsAlternativeMethodInfo
    ResolveTocEntryMethod "isSequence" o = TocEntryIsSequenceMethodInfo
    ResolveTocEntryMethod "mergeTags" o = TocEntryMergeTagsMethodInfo
    ResolveTocEntryMethod "getEntryType" o = TocEntryGetEntryTypeMethodInfo
    ResolveTocEntryMethod "getLoop" o = TocEntryGetLoopMethodInfo
    ResolveTocEntryMethod "getParent" o = TocEntryGetParentMethodInfo
    ResolveTocEntryMethod "getStartStopTimes" o = TocEntryGetStartStopTimesMethodInfo
    ResolveTocEntryMethod "getSubEntries" o = TocEntryGetSubEntriesMethodInfo
    ResolveTocEntryMethod "getTags" o = TocEntryGetTagsMethodInfo
    ResolveTocEntryMethod "getToc" o = TocEntryGetTocMethodInfo
    ResolveTocEntryMethod "getUid" o = TocEntryGetUidMethodInfo
    ResolveTocEntryMethod "setLoop" o = TocEntrySetLoopMethodInfo
    ResolveTocEntryMethod "setStartStopTimes" o = TocEntrySetStartStopTimesMethodInfo
    ResolveTocEntryMethod "setTags" o = TocEntrySetTagsMethodInfo
    ResolveTocEntryMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif