{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Encoding profiles for containers. Keeps track of a list of t'GI.GstPbutils.Objects.EncodingProfile.EncodingProfile'

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

module GI.GstPbutils.Objects.EncodingContainerProfile
    ( 

-- * Exported types
    EncodingContainerProfile(..)            ,
    IsEncodingContainerProfile              ,
    toEncodingContainerProfile              ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [addProfile]("GI.GstPbutils.Objects.EncodingContainerProfile#g:method:addProfile"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [containsProfile]("GI.GstPbutils.Objects.EncodingContainerProfile#g:method:containsProfile"), [copy]("GI.GstPbutils.Objects.EncodingProfile#g:method:copy"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isEnabled]("GI.GstPbutils.Objects.EncodingProfile#g:method:isEnabled"), [isEqual]("GI.GstPbutils.Objects.EncodingProfile#g:method:isEqual"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getAllowDynamicOutput]("GI.GstPbutils.Objects.EncodingProfile#g:method:getAllowDynamicOutput"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDescription]("GI.GstPbutils.Objects.EncodingProfile#g:method:getDescription"), [getElementProperties]("GI.GstPbutils.Objects.EncodingProfile#g:method:getElementProperties"), [getFileExtension]("GI.GstPbutils.Objects.EncodingProfile#g:method:getFileExtension"), [getFormat]("GI.GstPbutils.Objects.EncodingProfile#g:method:getFormat"), [getInputCaps]("GI.GstPbutils.Objects.EncodingProfile#g:method:getInputCaps"), [getName]("GI.GstPbutils.Objects.EncodingProfile#g:method:getName"), [getPresence]("GI.GstPbutils.Objects.EncodingProfile#g:method:getPresence"), [getPreset]("GI.GstPbutils.Objects.EncodingProfile#g:method:getPreset"), [getPresetName]("GI.GstPbutils.Objects.EncodingProfile#g:method:getPresetName"), [getProfiles]("GI.GstPbutils.Objects.EncodingContainerProfile#g:method:getProfiles"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getRestriction]("GI.GstPbutils.Objects.EncodingProfile#g:method:getRestriction"), [getSingleSegment]("GI.GstPbutils.Objects.EncodingProfile#g:method:getSingleSegment"), [getTypeNick]("GI.GstPbutils.Objects.EncodingProfile#g:method:getTypeNick").
-- 
-- ==== Setters
-- [setAllowDynamicOutput]("GI.GstPbutils.Objects.EncodingProfile#g:method:setAllowDynamicOutput"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setDescription]("GI.GstPbutils.Objects.EncodingProfile#g:method:setDescription"), [setElementProperties]("GI.GstPbutils.Objects.EncodingProfile#g:method:setElementProperties"), [setEnabled]("GI.GstPbutils.Objects.EncodingProfile#g:method:setEnabled"), [setFormat]("GI.GstPbutils.Objects.EncodingProfile#g:method:setFormat"), [setName]("GI.GstPbutils.Objects.EncodingProfile#g:method:setName"), [setPresence]("GI.GstPbutils.Objects.EncodingProfile#g:method:setPresence"), [setPreset]("GI.GstPbutils.Objects.EncodingProfile#g:method:setPreset"), [setPresetName]("GI.GstPbutils.Objects.EncodingProfile#g:method:setPresetName"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setRestriction]("GI.GstPbutils.Objects.EncodingProfile#g:method:setRestriction"), [setSingleSegment]("GI.GstPbutils.Objects.EncodingProfile#g:method:setSingleSegment").

#if defined(ENABLE_OVERLOADING)
    ResolveEncodingContainerProfileMethod   ,
#endif

-- ** addProfile #method:addProfile#

#if defined(ENABLE_OVERLOADING)
    EncodingContainerProfileAddProfileMethodInfo,
#endif
    encodingContainerProfileAddProfile      ,


-- ** containsProfile #method:containsProfile#

#if defined(ENABLE_OVERLOADING)
    EncodingContainerProfileContainsProfileMethodInfo,
#endif
    encodingContainerProfileContainsProfile ,


-- ** getProfiles #method:getProfiles#

#if defined(ENABLE_OVERLOADING)
    EncodingContainerProfileGetProfilesMethodInfo,
#endif
    encodingContainerProfileGetProfiles     ,


-- ** new #method:new#

    encodingContainerProfileNew             ,




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gst.Structs.Caps as Gst.Caps
import {-# SOURCE #-} qualified GI.GstPbutils.Objects.EncodingProfile as GstPbutils.EncodingProfile

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

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

foreign import ccall "gst_encoding_container_profile_get_type"
    c_gst_encoding_container_profile_get_type :: IO B.Types.GType

instance B.Types.TypedObject EncodingContainerProfile where
    glibType :: IO GType
glibType = IO GType
c_gst_encoding_container_profile_get_type

instance B.Types.GObject EncodingContainerProfile

-- | Type class for types which can be safely cast to `EncodingContainerProfile`, for instance with `toEncodingContainerProfile`.
class (SP.GObject o, O.IsDescendantOf EncodingContainerProfile o) => IsEncodingContainerProfile o
instance (SP.GObject o, O.IsDescendantOf EncodingContainerProfile o) => IsEncodingContainerProfile o

instance O.HasParentTypes EncodingContainerProfile
type instance O.ParentTypes EncodingContainerProfile = '[GstPbutils.EncodingProfile.EncodingProfile, GObject.Object.Object]

-- | Cast to `EncodingContainerProfile`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toEncodingContainerProfile :: (MIO.MonadIO m, IsEncodingContainerProfile o) => o -> m EncodingContainerProfile
toEncodingContainerProfile :: forall (m :: * -> *) o.
(MonadIO m, IsEncodingContainerProfile o) =>
o -> m EncodingContainerProfile
toEncodingContainerProfile = IO EncodingContainerProfile -> m EncodingContainerProfile
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO EncodingContainerProfile -> m EncodingContainerProfile)
-> (o -> IO EncodingContainerProfile)
-> o
-> m EncodingContainerProfile
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr EncodingContainerProfile -> EncodingContainerProfile)
-> o -> IO EncodingContainerProfile
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr EncodingContainerProfile -> EncodingContainerProfile
EncodingContainerProfile

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

#if defined(ENABLE_OVERLOADING)
type family ResolveEncodingContainerProfileMethod (t :: Symbol) (o :: *) :: * where
    ResolveEncodingContainerProfileMethod "addProfile" o = EncodingContainerProfileAddProfileMethodInfo
    ResolveEncodingContainerProfileMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveEncodingContainerProfileMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveEncodingContainerProfileMethod "containsProfile" o = EncodingContainerProfileContainsProfileMethodInfo
    ResolveEncodingContainerProfileMethod "copy" o = GstPbutils.EncodingProfile.EncodingProfileCopyMethodInfo
    ResolveEncodingContainerProfileMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveEncodingContainerProfileMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveEncodingContainerProfileMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveEncodingContainerProfileMethod "isEnabled" o = GstPbutils.EncodingProfile.EncodingProfileIsEnabledMethodInfo
    ResolveEncodingContainerProfileMethod "isEqual" o = GstPbutils.EncodingProfile.EncodingProfileIsEqualMethodInfo
    ResolveEncodingContainerProfileMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveEncodingContainerProfileMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveEncodingContainerProfileMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveEncodingContainerProfileMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveEncodingContainerProfileMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveEncodingContainerProfileMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveEncodingContainerProfileMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveEncodingContainerProfileMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveEncodingContainerProfileMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveEncodingContainerProfileMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveEncodingContainerProfileMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveEncodingContainerProfileMethod "getAllowDynamicOutput" o = GstPbutils.EncodingProfile.EncodingProfileGetAllowDynamicOutputMethodInfo
    ResolveEncodingContainerProfileMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveEncodingContainerProfileMethod "getDescription" o = GstPbutils.EncodingProfile.EncodingProfileGetDescriptionMethodInfo
    ResolveEncodingContainerProfileMethod "getElementProperties" o = GstPbutils.EncodingProfile.EncodingProfileGetElementPropertiesMethodInfo
    ResolveEncodingContainerProfileMethod "getFileExtension" o = GstPbutils.EncodingProfile.EncodingProfileGetFileExtensionMethodInfo
    ResolveEncodingContainerProfileMethod "getFormat" o = GstPbutils.EncodingProfile.EncodingProfileGetFormatMethodInfo
    ResolveEncodingContainerProfileMethod "getInputCaps" o = GstPbutils.EncodingProfile.EncodingProfileGetInputCapsMethodInfo
    ResolveEncodingContainerProfileMethod "getName" o = GstPbutils.EncodingProfile.EncodingProfileGetNameMethodInfo
    ResolveEncodingContainerProfileMethod "getPresence" o = GstPbutils.EncodingProfile.EncodingProfileGetPresenceMethodInfo
    ResolveEncodingContainerProfileMethod "getPreset" o = GstPbutils.EncodingProfile.EncodingProfileGetPresetMethodInfo
    ResolveEncodingContainerProfileMethod "getPresetName" o = GstPbutils.EncodingProfile.EncodingProfileGetPresetNameMethodInfo
    ResolveEncodingContainerProfileMethod "getProfiles" o = EncodingContainerProfileGetProfilesMethodInfo
    ResolveEncodingContainerProfileMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveEncodingContainerProfileMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveEncodingContainerProfileMethod "getRestriction" o = GstPbutils.EncodingProfile.EncodingProfileGetRestrictionMethodInfo
    ResolveEncodingContainerProfileMethod "getSingleSegment" o = GstPbutils.EncodingProfile.EncodingProfileGetSingleSegmentMethodInfo
    ResolveEncodingContainerProfileMethod "getTypeNick" o = GstPbutils.EncodingProfile.EncodingProfileGetTypeNickMethodInfo
    ResolveEncodingContainerProfileMethod "setAllowDynamicOutput" o = GstPbutils.EncodingProfile.EncodingProfileSetAllowDynamicOutputMethodInfo
    ResolveEncodingContainerProfileMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveEncodingContainerProfileMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveEncodingContainerProfileMethod "setDescription" o = GstPbutils.EncodingProfile.EncodingProfileSetDescriptionMethodInfo
    ResolveEncodingContainerProfileMethod "setElementProperties" o = GstPbutils.EncodingProfile.EncodingProfileSetElementPropertiesMethodInfo
    ResolveEncodingContainerProfileMethod "setEnabled" o = GstPbutils.EncodingProfile.EncodingProfileSetEnabledMethodInfo
    ResolveEncodingContainerProfileMethod "setFormat" o = GstPbutils.EncodingProfile.EncodingProfileSetFormatMethodInfo
    ResolveEncodingContainerProfileMethod "setName" o = GstPbutils.EncodingProfile.EncodingProfileSetNameMethodInfo
    ResolveEncodingContainerProfileMethod "setPresence" o = GstPbutils.EncodingProfile.EncodingProfileSetPresenceMethodInfo
    ResolveEncodingContainerProfileMethod "setPreset" o = GstPbutils.EncodingProfile.EncodingProfileSetPresetMethodInfo
    ResolveEncodingContainerProfileMethod "setPresetName" o = GstPbutils.EncodingProfile.EncodingProfileSetPresetNameMethodInfo
    ResolveEncodingContainerProfileMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveEncodingContainerProfileMethod "setRestriction" o = GstPbutils.EncodingProfile.EncodingProfileSetRestrictionMethodInfo
    ResolveEncodingContainerProfileMethod "setSingleSegment" o = GstPbutils.EncodingProfile.EncodingProfileSetSingleSegmentMethodInfo
    ResolveEncodingContainerProfileMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList EncodingContainerProfile
type instance O.AttributeList EncodingContainerProfile = EncodingContainerProfileAttributeList
type EncodingContainerProfileAttributeList = ('[ '("elementProperties", GstPbutils.EncodingProfile.EncodingProfileElementPropertiesPropertyInfo), '("restrictionCaps", GstPbutils.EncodingProfile.EncodingProfileRestrictionCapsPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList EncodingContainerProfile = EncodingContainerProfileSignalList
type EncodingContainerProfileSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method EncodingContainerProfile::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The name of the container profile, can be %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "description"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The description of the container profile,\n    can be %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The format to use for this profile"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "preset"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The preset to use for this profile."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name
--                    { namespace = "GstPbutils" , name = "EncodingContainerProfile" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_encoding_container_profile_new" gst_encoding_container_profile_new :: 
    CString ->                              -- name : TBasicType TUTF8
    CString ->                              -- description : TBasicType TUTF8
    Ptr Gst.Caps.Caps ->                    -- format : TInterface (Name {namespace = "Gst", name = "Caps"})
    CString ->                              -- preset : TBasicType TUTF8
    IO (Ptr EncodingContainerProfile)

-- | Creates a new t'GI.GstPbutils.Objects.EncodingContainerProfile.EncodingContainerProfile'.
encodingContainerProfileNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Maybe (T.Text)
    -- ^ /@name@/: The name of the container profile, can be 'P.Nothing'
    -> Maybe (T.Text)
    -- ^ /@description@/: The description of the container profile,
    --     can be 'P.Nothing'
    -> Gst.Caps.Caps
    -- ^ /@format@/: The format to use for this profile
    -> Maybe (T.Text)
    -- ^ /@preset@/: The preset to use for this profile.
    -> m EncodingContainerProfile
    -- ^ __Returns:__ The newly created t'GI.GstPbutils.Objects.EncodingContainerProfile.EncodingContainerProfile'.
encodingContainerProfileNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Maybe Text
-> Maybe Text -> Caps -> Maybe Text -> m EncodingContainerProfile
encodingContainerProfileNew Maybe Text
name Maybe Text
description Caps
format Maybe Text
preset = IO EncodingContainerProfile -> m EncodingContainerProfile
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO EncodingContainerProfile -> m EncodingContainerProfile)
-> IO EncodingContainerProfile -> m EncodingContainerProfile
forall a b. (a -> b) -> a -> b
$ do
    Ptr CChar
maybeName <- case Maybe Text
name of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jName -> do
            Ptr CChar
jName' <- Text -> IO (Ptr CChar)
textToCString Text
jName
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jName'
    Ptr CChar
maybeDescription <- case Maybe Text
description of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jDescription -> do
            Ptr CChar
jDescription' <- Text -> IO (Ptr CChar)
textToCString Text
jDescription
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jDescription'
    Ptr Caps
format' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
format
    Ptr CChar
maybePreset <- case Maybe Text
preset of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jPreset -> do
            Ptr CChar
jPreset' <- Text -> IO (Ptr CChar)
textToCString Text
jPreset
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jPreset'
    Ptr EncodingContainerProfile
result <- Ptr CChar
-> Ptr CChar
-> Ptr Caps
-> Ptr CChar
-> IO (Ptr EncodingContainerProfile)
gst_encoding_container_profile_new Ptr CChar
maybeName Ptr CChar
maybeDescription Ptr Caps
format' Ptr CChar
maybePreset
    Text -> Ptr EncodingContainerProfile -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"encodingContainerProfileNew" Ptr EncodingContainerProfile
result
    EncodingContainerProfile
result' <- ((ManagedPtr EncodingContainerProfile -> EncodingContainerProfile)
-> Ptr EncodingContainerProfile -> IO EncodingContainerProfile
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr EncodingContainerProfile -> EncodingContainerProfile
EncodingContainerProfile) Ptr EncodingContainerProfile
result
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
format
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeName
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeDescription
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybePreset
    EncodingContainerProfile -> IO EncodingContainerProfile
forall (m :: * -> *) a. Monad m => a -> m a
return EncodingContainerProfile
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method EncodingContainerProfile::add_profile
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface
--                 Name
--                   { namespace = "GstPbutils" , name = "EncodingContainerProfile" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstEncodingContainerProfile to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "profile"
--           , argType =
--               TInterface
--                 Name { namespace = "GstPbutils" , name = "EncodingProfile" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstEncodingProfile to add."
--                 , 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_encoding_container_profile_add_profile" gst_encoding_container_profile_add_profile :: 
    Ptr EncodingContainerProfile ->         -- container : TInterface (Name {namespace = "GstPbutils", name = "EncodingContainerProfile"})
    Ptr GstPbutils.EncodingProfile.EncodingProfile -> -- profile : TInterface (Name {namespace = "GstPbutils", name = "EncodingProfile"})
    IO CInt

-- | Add a t'GI.GstPbutils.Objects.EncodingProfile.EncodingProfile' to the list of profiles handled by /@container@/.
-- 
-- No copy of /@profile@/ will be made, if you wish to use it elsewhere after this
-- method you should increment its reference count.
encodingContainerProfileAddProfile ::
    (B.CallStack.HasCallStack, MonadIO m, IsEncodingContainerProfile a, GstPbutils.EncodingProfile.IsEncodingProfile b) =>
    a
    -- ^ /@container@/: the t'GI.GstPbutils.Objects.EncodingContainerProfile.EncodingContainerProfile' to use
    -> b
    -- ^ /@profile@/: the t'GI.GstPbutils.Objects.EncodingProfile.EncodingProfile' to add.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the /@stream@/ was properly added, else 'P.False'.
encodingContainerProfileAddProfile :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsEncodingContainerProfile a,
 IsEncodingProfile b) =>
a -> b -> m Bool
encodingContainerProfileAddProfile a
container b
profile = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr EncodingContainerProfile
container' <- a -> IO (Ptr EncodingContainerProfile)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    Ptr EncodingProfile
profile' <- b -> IO (Ptr EncodingProfile)
forall a b. (HasCallStack, GObject a) => a -> IO (Ptr b)
B.ManagedPtr.disownObject b
profile
    CInt
result <- Ptr EncodingContainerProfile -> Ptr EncodingProfile -> IO CInt
gst_encoding_container_profile_add_profile Ptr EncodingContainerProfile
container' Ptr EncodingProfile
profile'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
profile
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data EncodingContainerProfileAddProfileMethodInfo
instance (signature ~ (b -> m Bool), MonadIO m, IsEncodingContainerProfile a, GstPbutils.EncodingProfile.IsEncodingProfile b) => O.OverloadedMethod EncodingContainerProfileAddProfileMethodInfo a signature where
    overloadedMethod = encodingContainerProfileAddProfile

instance O.OverloadedMethodInfo EncodingContainerProfileAddProfileMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstPbutils.Objects.EncodingContainerProfile.encodingContainerProfileAddProfile",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstpbutils-1.0.24/docs/GI-GstPbutils-Objects-EncodingContainerProfile.html#v:encodingContainerProfileAddProfile"
        })


#endif

-- method EncodingContainerProfile::contains_profile
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface
--                 Name
--                   { namespace = "GstPbutils" , name = "EncodingContainerProfile" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstEncodingContainerProfile"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "profile"
--           , argType =
--               TInterface
--                 Name { namespace = "GstPbutils" , name = "EncodingProfile" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstEncodingProfile"
--                 , 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_encoding_container_profile_contains_profile" gst_encoding_container_profile_contains_profile :: 
    Ptr EncodingContainerProfile ->         -- container : TInterface (Name {namespace = "GstPbutils", name = "EncodingContainerProfile"})
    Ptr GstPbutils.EncodingProfile.EncodingProfile -> -- profile : TInterface (Name {namespace = "GstPbutils", name = "EncodingProfile"})
    IO CInt

-- | Checks if /@container@/ contains a t'GI.GstPbutils.Objects.EncodingProfile.EncodingProfile' identical to
-- /@profile@/.
encodingContainerProfileContainsProfile ::
    (B.CallStack.HasCallStack, MonadIO m, IsEncodingContainerProfile a, GstPbutils.EncodingProfile.IsEncodingProfile b) =>
    a
    -- ^ /@container@/: a t'GI.GstPbutils.Objects.EncodingContainerProfile.EncodingContainerProfile'
    -> b
    -- ^ /@profile@/: a t'GI.GstPbutils.Objects.EncodingProfile.EncodingProfile'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@container@/ contains a t'GI.GstPbutils.Objects.EncodingProfile.EncodingProfile' identical
    -- to /@profile@/, else 'P.False'.
encodingContainerProfileContainsProfile :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsEncodingContainerProfile a,
 IsEncodingProfile b) =>
a -> b -> m Bool
encodingContainerProfileContainsProfile a
container b
profile = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr EncodingContainerProfile
container' <- a -> IO (Ptr EncodingContainerProfile)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    Ptr EncodingProfile
profile' <- b -> IO (Ptr EncodingProfile)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
profile
    CInt
result <- Ptr EncodingContainerProfile -> Ptr EncodingProfile -> IO CInt
gst_encoding_container_profile_contains_profile Ptr EncodingContainerProfile
container' Ptr EncodingProfile
profile'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
profile
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data EncodingContainerProfileContainsProfileMethodInfo
instance (signature ~ (b -> m Bool), MonadIO m, IsEncodingContainerProfile a, GstPbutils.EncodingProfile.IsEncodingProfile b) => O.OverloadedMethod EncodingContainerProfileContainsProfileMethodInfo a signature where
    overloadedMethod = encodingContainerProfileContainsProfile

instance O.OverloadedMethodInfo EncodingContainerProfileContainsProfileMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstPbutils.Objects.EncodingContainerProfile.encodingContainerProfileContainsProfile",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstpbutils-1.0.24/docs/GI-GstPbutils-Objects-EncodingContainerProfile.html#v:encodingContainerProfileContainsProfile"
        })


#endif

-- method EncodingContainerProfile::get_profiles
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "profile"
--           , argType =
--               TInterface
--                 Name
--                   { namespace = "GstPbutils" , name = "EncodingContainerProfile" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstEncodingContainerProfile"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList
--                  (TInterface
--                     Name { namespace = "GstPbutils" , name = "EncodingProfile" }))
-- throws : False
-- Skip return : False

foreign import ccall "gst_encoding_container_profile_get_profiles" gst_encoding_container_profile_get_profiles :: 
    Ptr EncodingContainerProfile ->         -- profile : TInterface (Name {namespace = "GstPbutils", name = "EncodingContainerProfile"})
    IO (Ptr (GList (Ptr GstPbutils.EncodingProfile.EncodingProfile)))

-- | /No description available in the introspection data./
encodingContainerProfileGetProfiles ::
    (B.CallStack.HasCallStack, MonadIO m, IsEncodingContainerProfile a) =>
    a
    -- ^ /@profile@/: a t'GI.GstPbutils.Objects.EncodingContainerProfile.EncodingContainerProfile'
    -> m [GstPbutils.EncodingProfile.EncodingProfile]
    -- ^ __Returns:__ 
    -- the list of contained t'GI.GstPbutils.Objects.EncodingProfile.EncodingProfile'.
encodingContainerProfileGetProfiles :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEncodingContainerProfile a) =>
a -> m [EncodingProfile]
encodingContainerProfileGetProfiles a
profile = IO [EncodingProfile] -> m [EncodingProfile]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [EncodingProfile] -> m [EncodingProfile])
-> IO [EncodingProfile] -> m [EncodingProfile]
forall a b. (a -> b) -> a -> b
$ do
    Ptr EncodingContainerProfile
profile' <- a -> IO (Ptr EncodingContainerProfile)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
profile
    Ptr (GList (Ptr EncodingProfile))
result <- Ptr EncodingContainerProfile
-> IO (Ptr (GList (Ptr EncodingProfile)))
gst_encoding_container_profile_get_profiles Ptr EncodingContainerProfile
profile'
    [Ptr EncodingProfile]
result' <- Ptr (GList (Ptr EncodingProfile)) -> IO [Ptr EncodingProfile]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr EncodingProfile))
result
    [EncodingProfile]
result'' <- (Ptr EncodingProfile -> IO EncodingProfile)
-> [Ptr EncodingProfile] -> IO [EncodingProfile]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr EncodingProfile -> EncodingProfile)
-> Ptr EncodingProfile -> IO EncodingProfile
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr EncodingProfile -> EncodingProfile
GstPbutils.EncodingProfile.EncodingProfile) [Ptr EncodingProfile]
result'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
profile
    [EncodingProfile] -> IO [EncodingProfile]
forall (m :: * -> *) a. Monad m => a -> m a
return [EncodingProfile]
result''

#if defined(ENABLE_OVERLOADING)
data EncodingContainerProfileGetProfilesMethodInfo
instance (signature ~ (m [GstPbutils.EncodingProfile.EncodingProfile]), MonadIO m, IsEncodingContainerProfile a) => O.OverloadedMethod EncodingContainerProfileGetProfilesMethodInfo a signature where
    overloadedMethod = encodingContainerProfileGetProfiles

instance O.OverloadedMethodInfo EncodingContainerProfileGetProfilesMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstPbutils.Objects.EncodingContainerProfile.encodingContainerProfileGetProfiles",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstpbutils-1.0.24/docs/GI-GstPbutils-Objects-EncodingContainerProfile.html#v:encodingContainerProfileGetProfiles"
        })


#endif