{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- t'GI.Gst.Structs.Toc.Toc' functions are used to create\/free t'GI.Gst.Structs.Toc.Toc' and t'GI.Gst.Structs.TocEntry.TocEntry' structures.
-- Also they are used to convert t'GI.Gst.Structs.Toc.Toc' into t'GI.Gst.Structs.Structure.Structure' and vice versa.
-- 
-- t'GI.Gst.Structs.Toc.Toc' lets you to inform other elements in pipeline or application that playing
-- source has some kind of table of contents (TOC). These may be chapters, editions,
-- angles or other types. For example: DVD chapters, Matroska chapters or cue sheet
-- TOC. Such TOC will be useful for applications to display instead of just a
-- playlist.
-- 
-- Using TOC is very easy. Firstly, create t'GI.Gst.Structs.Toc.Toc' structure which represents root
-- contents of the source. You can also attach TOC-specific tags to it. Then fill
-- it with t'GI.Gst.Structs.TocEntry.TocEntry' entries by appending them to the t'GI.Gst.Structs.Toc.Toc' using
-- 'GI.Gst.Structs.Toc.tocAppendEntry', and appending subentries to a t'GI.Gst.Structs.TocEntry.TocEntry' using
-- 'GI.Gst.Structs.TocEntry.tocEntryAppendSubEntry'.
-- 
-- Note that root level of the TOC can contain only either editions or chapters. You
-- should not mix them together at the same level. Otherwise you will get serialization
-- \/deserialization errors. Make sure that no one of the entries has negative start and
--  stop values.
-- 
-- Use 'GI.Gst.Structs.Event.eventNewToc' to create a new TOC t'GI.Gst.Structs.Event.Event', and 'GI.Gst.Structs.Event.eventParseToc' to
-- parse received TOC event. Use 'GI.Gst.Structs.Event.eventNewTocSelect' to create a new TOC select t'GI.Gst.Structs.Event.Event',
-- and 'GI.Gst.Structs.Event.eventParseTocSelect' to parse received TOC select event. The same rule for
-- the t'GI.Gst.Structs.Message.Message': 'GI.Gst.Structs.Message.messageNewToc' to create new TOC t'GI.Gst.Structs.Message.Message', and
-- 'GI.Gst.Structs.Message.messageParseToc' to parse received TOC message.
-- 
-- TOCs can have global scope or current scope. Global scope TOCs contain
-- all entries that can possibly be selected using a toc select event, and
-- are what an application is usually interested in. TOCs with current scope
-- only contain the parts of the TOC relevant to the currently selected\/playing
-- stream; the current scope TOC is used by downstream elements such as muxers
-- to write correct TOC entries when transcoding files, for example. When
-- playing a DVD, the global TOC would contain a hierarchy of all titles,
-- chapters and angles, for example, while the current TOC would only contain
-- the chapters for the currently playing title if playback of a specific
-- title was requested.
-- 
-- Applications and plugins should not rely on TOCs having a certain kind of
-- structure, but should allow for different alternatives. For example, a
-- simple CUE sheet embedded in a file may be presented as a flat list of
-- track entries, or could have a top-level edition node (or some other
-- alternative type entry) with track entries underneath that node; or even
-- multiple top-level edition nodes (or some other alternative type entries)
-- each with track entries underneath, in case the source file has extracted
-- a track listing from different sources).

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

module GI.Gst.Structs.Toc
    ( 

-- * Exported types
    Toc(..)                                 ,
    noToc                                   ,


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolveTocMethod                        ,
#endif


-- ** appendEntry #method:appendEntry#

#if defined(ENABLE_OVERLOADING)
    TocAppendEntryMethodInfo                ,
#endif
    tocAppendEntry                          ,


-- ** dump #method:dump#

#if defined(ENABLE_OVERLOADING)
    TocDumpMethodInfo                       ,
#endif
    tocDump                                 ,


-- ** findEntry #method:findEntry#

#if defined(ENABLE_OVERLOADING)
    TocFindEntryMethodInfo                  ,
#endif
    tocFindEntry                            ,


-- ** getEntries #method:getEntries#

#if defined(ENABLE_OVERLOADING)
    TocGetEntriesMethodInfo                 ,
#endif
    tocGetEntries                           ,


-- ** getScope #method:getScope#

#if defined(ENABLE_OVERLOADING)
    TocGetScopeMethodInfo                   ,
#endif
    tocGetScope                             ,


-- ** getTags #method:getTags#

#if defined(ENABLE_OVERLOADING)
    TocGetTagsMethodInfo                    ,
#endif
    tocGetTags                              ,


-- ** mergeTags #method:mergeTags#

#if defined(ENABLE_OVERLOADING)
    TocMergeTagsMethodInfo                  ,
#endif
    tocMergeTags                            ,


-- ** new #method:new#

    tocNew                                  ,


-- ** setTags #method:setTags#

#if defined(ENABLE_OVERLOADING)
    TocSetTagsMethodInfo                    ,
#endif
    tocSetTags                              ,




    ) where

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

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

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.TocEntry as Gst.TocEntry

-- | Memory-managed wrapper type.
newtype Toc = Toc (ManagedPtr Toc)
    deriving (Toc -> Toc -> Bool
(Toc -> Toc -> Bool) -> (Toc -> Toc -> Bool) -> Eq Toc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Toc -> Toc -> Bool
$c/= :: Toc -> Toc -> Bool
== :: Toc -> Toc -> Bool
$c== :: Toc -> Toc -> Bool
Eq)
foreign import ccall "gst_toc_get_type" c_gst_toc_get_type :: 
    IO GType

instance BoxedObject Toc where
    boxedType :: Toc -> IO GType
boxedType _ = IO GType
c_gst_toc_get_type

-- | Convert 'Toc' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue Toc where
    toGValue :: Toc -> IO GValue
toGValue o :: Toc
o = do
        GType
gtype <- IO GType
c_gst_toc_get_type
        Toc -> (Ptr Toc -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Toc
o (GType -> (GValue -> Ptr Toc -> IO ()) -> Ptr Toc -> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr Toc -> IO ()
forall a. GValue -> Ptr a -> IO ()
B.GValue.set_boxed)
        
    fromGValue :: GValue -> IO Toc
fromGValue gv :: GValue
gv = do
        Ptr Toc
ptr <- GValue -> IO (Ptr Toc)
forall b. GValue -> IO (Ptr b)
B.GValue.get_boxed GValue
gv :: IO (Ptr Toc)
        (ManagedPtr Toc -> Toc) -> Ptr Toc -> IO Toc
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr Toc -> Toc
Toc Ptr Toc
ptr
        
    

-- | A convenience alias for `Nothing` :: `Maybe` `Toc`.
noToc :: Maybe Toc
noToc :: Maybe Toc
noToc = Maybe Toc
forall a. Maybe a
Nothing


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

-- method Toc::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "scope"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TocScope" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "scope of this TOC" , 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_new" gst_toc_new :: 
    CUInt ->                                -- scope : TInterface (Name {namespace = "Gst", name = "TocScope"})
    IO (Ptr Toc)

-- | Create a new t'GI.Gst.Structs.Toc.Toc' structure.
tocNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Enums.TocScope
    -- ^ /@scope@/: scope of this TOC
    -> m Toc
    -- ^ __Returns:__ newly allocated t'GI.Gst.Structs.Toc.Toc' structure, free it
    --     with @/gst_toc_unref()/@.
tocNew :: TocScope -> m Toc
tocNew scope :: TocScope
scope = IO Toc -> m Toc
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
    let scope' :: CUInt
scope' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (TocScope -> Int) -> TocScope -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TocScope -> Int
forall a. Enum a => a -> Int
fromEnum) TocScope
scope
    Ptr Toc
result <- CUInt -> IO (Ptr Toc)
gst_toc_new CUInt
scope'
    Text -> Ptr Toc -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "tocNew" Ptr Toc
result
    Toc
result' <- ((ManagedPtr Toc -> Toc) -> Ptr Toc -> IO Toc
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Toc -> Toc
Toc) Ptr Toc
result
    Toc -> IO Toc
forall (m :: * -> *) a. Monad m => a -> m a
return Toc
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Toc::append_entry
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "toc"
--           , argType = TInterface Name { namespace = "Gst" , name = "Toc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GstToc instance" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , 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 = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Appends the t'GI.Gst.Structs.TocEntry.TocEntry' /@entry@/ to /@toc@/.
tocAppendEntry ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Toc
    -- ^ /@toc@/: A t'GI.Gst.Structs.Toc.Toc' instance
    -> Gst.TocEntry.TocEntry
    -- ^ /@entry@/: A t'GI.Gst.Structs.TocEntry.TocEntry'
    -> m ()
tocAppendEntry :: Toc -> TocEntry -> m ()
tocAppendEntry toc :: Toc
toc entry :: TocEntry
entry = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Toc
toc' <- Toc -> IO (Ptr Toc)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Toc
toc
    Ptr TocEntry
entry' <- TocEntry -> IO (Ptr TocEntry)
forall a. (HasCallStack, BoxedObject a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed TocEntry
entry
    Ptr Toc -> Ptr TocEntry -> IO ()
gst_toc_append_entry Ptr Toc
toc' Ptr TocEntry
entry'
    Toc -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Toc
toc
    TocEntry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TocEntry
entry
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TocAppendEntryMethodInfo
instance (signature ~ (Gst.TocEntry.TocEntry -> m ()), MonadIO m) => O.MethodInfo TocAppendEntryMethodInfo Toc signature where
    overloadedMethod = tocAppendEntry

#endif

-- method Toc::dump
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "toc"
--           , argType = TInterface Name { namespace = "Gst" , name = "Toc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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_dump" gst_toc_dump :: 
    Ptr Toc ->                              -- toc : TInterface (Name {namespace = "Gst", name = "Toc"})
    IO ()

-- | /No description available in the introspection data./
tocDump ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Toc
    -> m ()
tocDump :: Toc -> m ()
tocDump toc :: Toc
toc = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Toc
toc' <- Toc -> IO (Ptr Toc)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Toc
toc
    Ptr Toc -> IO ()
gst_toc_dump Ptr Toc
toc'
    Toc -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Toc
toc
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TocDumpMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo TocDumpMethodInfo Toc signature where
    overloadedMethod = tocDump

#endif

-- method Toc::find_entry
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "toc"
--           , argType = TInterface Name { namespace = "Gst" , name = "Toc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GstToc to search in."
--                 , 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 "UID to find #GstTocEntry with."
--                 , 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_find_entry" gst_toc_find_entry :: 
    Ptr Toc ->                              -- toc : TInterface (Name {namespace = "Gst", name = "Toc"})
    CString ->                              -- uid : TBasicType TUTF8
    IO (Ptr Gst.TocEntry.TocEntry)

-- | Find t'GI.Gst.Structs.TocEntry.TocEntry' with given /@uid@/ in the /@toc@/.
tocFindEntry ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Toc
    -- ^ /@toc@/: t'GI.Gst.Structs.Toc.Toc' to search in.
    -> T.Text
    -- ^ /@uid@/: UID to find t'GI.Gst.Structs.TocEntry.TocEntry' with.
    -> m (Maybe Gst.TocEntry.TocEntry)
    -- ^ __Returns:__ t'GI.Gst.Structs.TocEntry.TocEntry' with specified
    -- /@uid@/ from the /@toc@/, or 'P.Nothing' if not found.
tocFindEntry :: Toc -> Text -> m (Maybe TocEntry)
tocFindEntry toc :: Toc
toc uid :: Text
uid = IO (Maybe TocEntry) -> m (Maybe TocEntry)
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 Toc
toc' <- Toc -> IO (Ptr Toc)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Toc
toc
    CString
uid' <- Text -> IO CString
textToCString Text
uid
    Ptr TocEntry
result <- Ptr Toc -> CString -> IO (Ptr TocEntry)
gst_toc_find_entry Ptr Toc
toc' CString
uid'
    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
$ \result' :: Ptr TocEntry
result' -> do
        TocEntry
result'' <- ((ManagedPtr TocEntry -> TocEntry) -> Ptr TocEntry -> IO TocEntry
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr TocEntry -> TocEntry
Gst.TocEntry.TocEntry) Ptr TocEntry
result'
        TocEntry -> IO TocEntry
forall (m :: * -> *) a. Monad m => a -> m a
return TocEntry
result''
    Toc -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Toc
toc
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
uid'
    Maybe TocEntry -> IO (Maybe TocEntry)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TocEntry
maybeResult

#if defined(ENABLE_OVERLOADING)
data TocFindEntryMethodInfo
instance (signature ~ (T.Text -> m (Maybe Gst.TocEntry.TocEntry)), MonadIO m) => O.MethodInfo TocFindEntryMethodInfo Toc signature where
    overloadedMethod = tocFindEntry

#endif

-- method Toc::get_entries
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "toc"
--           , argType = TInterface Name { namespace = "Gst" , name = "Toc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GstToc 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_get_entries" gst_toc_get_entries :: 
    Ptr Toc ->                              -- toc : TInterface (Name {namespace = "Gst", name = "Toc"})
    IO (Ptr (GList (Ptr Gst.TocEntry.TocEntry)))

-- | Gets the list of t'GI.Gst.Structs.TocEntry.TocEntry' of /@toc@/.
tocGetEntries ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Toc
    -- ^ /@toc@/: A t'GI.Gst.Structs.Toc.Toc' instance
    -> m [Gst.TocEntry.TocEntry]
    -- ^ __Returns:__ A t'GI.GLib.Structs.List.List' of t'GI.Gst.Structs.TocEntry.TocEntry' for /@entry@/
tocGetEntries :: Toc -> m [TocEntry]
tocGetEntries toc :: Toc
toc = IO [TocEntry] -> m [TocEntry]
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 Toc
toc' <- Toc -> IO (Ptr Toc)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Toc
toc
    Ptr (GList (Ptr TocEntry))
result <- Ptr Toc -> IO (Ptr (GList (Ptr TocEntry)))
gst_toc_get_entries Ptr Toc
toc'
    [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)
mapM ((ManagedPtr TocEntry -> TocEntry) -> Ptr TocEntry -> IO TocEntry
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr TocEntry -> TocEntry
Gst.TocEntry.TocEntry) [Ptr TocEntry]
result'
    Toc -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Toc
toc
    [TocEntry] -> IO [TocEntry]
forall (m :: * -> *) a. Monad m => a -> m a
return [TocEntry]
result''

#if defined(ENABLE_OVERLOADING)
data TocGetEntriesMethodInfo
instance (signature ~ (m [Gst.TocEntry.TocEntry]), MonadIO m) => O.MethodInfo TocGetEntriesMethodInfo Toc signature where
    overloadedMethod = tocGetEntries

#endif

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

foreign import ccall "gst_toc_get_scope" gst_toc_get_scope :: 
    Ptr Toc ->                              -- toc : TInterface (Name {namespace = "Gst", name = "Toc"})
    IO CUInt

-- | /No description available in the introspection data./
tocGetScope ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Toc
    -- ^ /@toc@/: a t'GI.Gst.Structs.Toc.Toc' instance
    -> m Gst.Enums.TocScope
    -- ^ __Returns:__ scope of /@toc@/
tocGetScope :: Toc -> m TocScope
tocGetScope toc :: Toc
toc = IO TocScope -> m TocScope
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TocScope -> m TocScope) -> IO TocScope -> m TocScope
forall a b. (a -> b) -> a -> b
$ do
    Ptr Toc
toc' <- Toc -> IO (Ptr Toc)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Toc
toc
    CUInt
result <- Ptr Toc -> IO CUInt
gst_toc_get_scope Ptr Toc
toc'
    let result' :: TocScope
result' = (Int -> TocScope
forall a. Enum a => Int -> a
toEnum (Int -> TocScope) -> (CUInt -> Int) -> CUInt -> TocScope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    Toc -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Toc
toc
    TocScope -> IO TocScope
forall (m :: * -> *) a. Monad m => a -> m a
return TocScope
result'

#if defined(ENABLE_OVERLOADING)
data TocGetScopeMethodInfo
instance (signature ~ (m Gst.Enums.TocScope), MonadIO m) => O.MethodInfo TocGetScopeMethodInfo Toc signature where
    overloadedMethod = tocGetScope

#endif

-- method Toc::get_tags
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "toc"
--           , argType = TInterface Name { namespace = "Gst" , name = "Toc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GstToc 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_get_tags" gst_toc_get_tags :: 
    Ptr Toc ->                              -- toc : TInterface (Name {namespace = "Gst", name = "Toc"})
    IO (Ptr Gst.TagList.TagList)

-- | Gets the tags for /@toc@/.
tocGetTags ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Toc
    -- ^ /@toc@/: A t'GI.Gst.Structs.Toc.Toc' instance
    -> m Gst.TagList.TagList
    -- ^ __Returns:__ A t'GI.Gst.Structs.TagList.TagList' for /@entry@/
tocGetTags :: Toc -> m TagList
tocGetTags toc :: Toc
toc = IO TagList -> m TagList
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 Toc
toc' <- Toc -> IO (Ptr Toc)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Toc
toc
    Ptr TagList
result <- Ptr Toc -> IO (Ptr TagList)
gst_toc_get_tags Ptr Toc
toc'
    Text -> Ptr TagList -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "tocGetTags" Ptr TagList
result
    TagList
result' <- ((ManagedPtr TagList -> TagList) -> Ptr TagList -> IO TagList
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr TagList -> TagList
Gst.TagList.TagList) Ptr TagList
result
    Toc -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Toc
toc
    TagList -> IO TagList
forall (m :: * -> *) a. Monad m => a -> m a
return TagList
result'

#if defined(ENABLE_OVERLOADING)
data TocGetTagsMethodInfo
instance (signature ~ (m Gst.TagList.TagList), MonadIO m) => O.MethodInfo TocGetTagsMethodInfo Toc signature where
    overloadedMethod = tocGetTags

#endif

-- method Toc::merge_tags
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "toc"
--           , argType = TInterface Name { namespace = "Gst" , name = "Toc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GstToc 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_merge_tags" gst_toc_merge_tags :: 
    Ptr Toc ->                              -- toc : TInterface (Name {namespace = "Gst", name = "Toc"})
    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 /@toc@/ using /@mode@/.
tocMergeTags ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Toc
    -- ^ /@toc@/: A t'GI.Gst.Structs.Toc.Toc' 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 ()
tocMergeTags :: Toc -> Maybe TagList -> TagMergeMode -> m ()
tocMergeTags toc :: Toc
toc tags :: Maybe TagList
tags mode :: TagMergeMode
mode = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Toc
toc' <- Toc -> IO (Ptr Toc)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Toc
toc
    Ptr TagList
maybeTags <- case Maybe TagList
tags of
        Nothing -> Ptr TagList -> IO (Ptr TagList)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TagList
forall a. Ptr a
nullPtr
        Just jTags :: 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 (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 Toc -> Ptr TagList -> CUInt -> IO ()
gst_toc_merge_tags Ptr Toc
toc' Ptr TagList
maybeTags CUInt
mode'
    Toc -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Toc
toc
    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 (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TocMergeTagsMethodInfo
instance (signature ~ (Maybe (Gst.TagList.TagList) -> Gst.Enums.TagMergeMode -> m ()), MonadIO m) => O.MethodInfo TocMergeTagsMethodInfo Toc signature where
    overloadedMethod = tocMergeTags

#endif

-- method Toc::set_tags
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "toc"
--           , argType = TInterface Name { namespace = "Gst" , name = "Toc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GstToc 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_set_tags" gst_toc_set_tags :: 
    Ptr Toc ->                              -- toc : TInterface (Name {namespace = "Gst", name = "Toc"})
    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 /@toc@/.
tocSetTags ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Toc
    -- ^ /@toc@/: A t'GI.Gst.Structs.Toc.Toc' instance
    -> Maybe (Gst.TagList.TagList)
    -- ^ /@tags@/: A t'GI.Gst.Structs.TagList.TagList' or 'P.Nothing'
    -> m ()
tocSetTags :: Toc -> Maybe TagList -> m ()
tocSetTags toc :: Toc
toc tags :: Maybe TagList
tags = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Toc
toc' <- Toc -> IO (Ptr Toc)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Toc
toc
    Ptr TagList
maybeTags <- case Maybe TagList
tags of
        Nothing -> Ptr TagList -> IO (Ptr TagList)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TagList
forall a. Ptr a
nullPtr
        Just jTags :: TagList
jTags -> do
            Ptr TagList
jTags' <- TagList -> IO (Ptr TagList)
forall a. (HasCallStack, BoxedObject a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed TagList
jTags
            Ptr TagList -> IO (Ptr TagList)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TagList
jTags'
    Ptr Toc -> Ptr TagList -> IO ()
gst_toc_set_tags Ptr Toc
toc' Ptr TagList
maybeTags
    Toc -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Toc
toc
    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 (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TocSetTagsMethodInfo
instance (signature ~ (Maybe (Gst.TagList.TagList) -> m ()), MonadIO m) => O.MethodInfo TocSetTagsMethodInfo Toc signature where
    overloadedMethod = tocSetTags

#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveTocMethod (t :: Symbol) (o :: *) :: * where
    ResolveTocMethod "appendEntry" o = TocAppendEntryMethodInfo
    ResolveTocMethod "dump" o = TocDumpMethodInfo
    ResolveTocMethod "findEntry" o = TocFindEntryMethodInfo
    ResolveTocMethod "mergeTags" o = TocMergeTagsMethodInfo
    ResolveTocMethod "getEntries" o = TocGetEntriesMethodInfo
    ResolveTocMethod "getScope" o = TocGetScopeMethodInfo
    ResolveTocMethod "getTags" o = TocGetTagsMethodInfo
    ResolveTocMethod "setTags" o = TocSetTagsMethodInfo
    ResolveTocMethod l o = O.MethodResolutionFailed l o

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

#endif