{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The opaque base class object for all encoding profiles. This contains generic
-- information like name, description, format and preset.

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

module GI.GstPbutils.Objects.EncodingProfile
    ( 

-- * Exported types
    EncodingProfile(..)                     ,
    IsEncodingProfile                       ,
    toEncodingProfile                       ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveEncodingProfileMethod            ,
#endif


-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    EncodingProfileCopyMethodInfo           ,
#endif
    encodingProfileCopy                     ,


-- ** find #method:find#

    encodingProfileFind                     ,


-- ** fromDiscoverer #method:fromDiscoverer#

    encodingProfileFromDiscoverer           ,


-- ** getAllowDynamicOutput #method:getAllowDynamicOutput#

#if defined(ENABLE_OVERLOADING)
    EncodingProfileGetAllowDynamicOutputMethodInfo,
#endif
    encodingProfileGetAllowDynamicOutput    ,


-- ** getDescription #method:getDescription#

#if defined(ENABLE_OVERLOADING)
    EncodingProfileGetDescriptionMethodInfo ,
#endif
    encodingProfileGetDescription           ,


-- ** getFileExtension #method:getFileExtension#

#if defined(ENABLE_OVERLOADING)
    EncodingProfileGetFileExtensionMethodInfo,
#endif
    encodingProfileGetFileExtension         ,


-- ** getFormat #method:getFormat#

#if defined(ENABLE_OVERLOADING)
    EncodingProfileGetFormatMethodInfo      ,
#endif
    encodingProfileGetFormat                ,


-- ** getInputCaps #method:getInputCaps#

#if defined(ENABLE_OVERLOADING)
    EncodingProfileGetInputCapsMethodInfo   ,
#endif
    encodingProfileGetInputCaps             ,


-- ** getName #method:getName#

#if defined(ENABLE_OVERLOADING)
    EncodingProfileGetNameMethodInfo        ,
#endif
    encodingProfileGetName                  ,


-- ** getPresence #method:getPresence#

#if defined(ENABLE_OVERLOADING)
    EncodingProfileGetPresenceMethodInfo    ,
#endif
    encodingProfileGetPresence              ,


-- ** getPreset #method:getPreset#

#if defined(ENABLE_OVERLOADING)
    EncodingProfileGetPresetMethodInfo      ,
#endif
    encodingProfileGetPreset                ,


-- ** getPresetName #method:getPresetName#

#if defined(ENABLE_OVERLOADING)
    EncodingProfileGetPresetNameMethodInfo  ,
#endif
    encodingProfileGetPresetName            ,


-- ** getRestriction #method:getRestriction#

#if defined(ENABLE_OVERLOADING)
    EncodingProfileGetRestrictionMethodInfo ,
#endif
    encodingProfileGetRestriction           ,


-- ** getTypeNick #method:getTypeNick#

#if defined(ENABLE_OVERLOADING)
    EncodingProfileGetTypeNickMethodInfo    ,
#endif
    encodingProfileGetTypeNick              ,


-- ** isEnabled #method:isEnabled#

#if defined(ENABLE_OVERLOADING)
    EncodingProfileIsEnabledMethodInfo      ,
#endif
    encodingProfileIsEnabled                ,


-- ** isEqual #method:isEqual#

#if defined(ENABLE_OVERLOADING)
    EncodingProfileIsEqualMethodInfo        ,
#endif
    encodingProfileIsEqual                  ,


-- ** setAllowDynamicOutput #method:setAllowDynamicOutput#

#if defined(ENABLE_OVERLOADING)
    EncodingProfileSetAllowDynamicOutputMethodInfo,
#endif
    encodingProfileSetAllowDynamicOutput    ,


-- ** setDescription #method:setDescription#

#if defined(ENABLE_OVERLOADING)
    EncodingProfileSetDescriptionMethodInfo ,
#endif
    encodingProfileSetDescription           ,


-- ** setEnabled #method:setEnabled#

#if defined(ENABLE_OVERLOADING)
    EncodingProfileSetEnabledMethodInfo     ,
#endif
    encodingProfileSetEnabled               ,


-- ** setFormat #method:setFormat#

#if defined(ENABLE_OVERLOADING)
    EncodingProfileSetFormatMethodInfo      ,
#endif
    encodingProfileSetFormat                ,


-- ** setName #method:setName#

#if defined(ENABLE_OVERLOADING)
    EncodingProfileSetNameMethodInfo        ,
#endif
    encodingProfileSetName                  ,


-- ** setPresence #method:setPresence#

#if defined(ENABLE_OVERLOADING)
    EncodingProfileSetPresenceMethodInfo    ,
#endif
    encodingProfileSetPresence              ,


-- ** setPreset #method:setPreset#

#if defined(ENABLE_OVERLOADING)
    EncodingProfileSetPresetMethodInfo      ,
#endif
    encodingProfileSetPreset                ,


-- ** setPresetName #method:setPresetName#

#if defined(ENABLE_OVERLOADING)
    EncodingProfileSetPresetNameMethodInfo  ,
#endif
    encodingProfileSetPresetName            ,


-- ** setRestriction #method:setRestriction#

#if defined(ENABLE_OVERLOADING)
    EncodingProfileSetRestrictionMethodInfo ,
#endif
    encodingProfileSetRestriction           ,




 -- * Properties
-- ** restrictionCaps #attr:restrictionCaps#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    EncodingProfileRestrictionCapsPropertyInfo,
#endif
    clearEncodingProfileRestrictionCaps     ,
    constructEncodingProfileRestrictionCaps ,
#if defined(ENABLE_OVERLOADING)
    encodingProfileRestrictionCaps          ,
#endif
    getEncodingProfileRestrictionCaps       ,
    setEncodingProfileRestrictionCaps       ,




    ) 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.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

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

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

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

foreign import ccall "gst_encoding_profile_get_type"
    c_gst_encoding_profile_get_type :: IO B.Types.GType

instance B.Types.TypedObject EncodingProfile where
    glibType :: IO GType
glibType = IO GType
c_gst_encoding_profile_get_type

instance B.Types.GObject EncodingProfile

-- | Convert 'EncodingProfile' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue EncodingProfile where
    toGValue :: EncodingProfile -> IO GValue
toGValue EncodingProfile
o = do
        GType
gtype <- IO GType
c_gst_encoding_profile_get_type
        EncodingProfile -> (Ptr EncodingProfile -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr EncodingProfile
o (GType
-> (GValue -> Ptr EncodingProfile -> IO ())
-> Ptr EncodingProfile
-> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr EncodingProfile -> IO ()
forall a. GObject a => GValue -> Ptr a -> IO ()
B.GValue.set_object)
        
    fromGValue :: GValue -> IO EncodingProfile
fromGValue GValue
gv = do
        Ptr EncodingProfile
ptr <- GValue -> IO (Ptr EncodingProfile)
forall b. GObject b => GValue -> IO (Ptr b)
B.GValue.get_object GValue
gv :: IO (Ptr EncodingProfile)
        (ManagedPtr EncodingProfile -> EncodingProfile)
-> Ptr EncodingProfile -> IO EncodingProfile
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr EncodingProfile -> EncodingProfile
EncodingProfile Ptr EncodingProfile
ptr
        
    

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

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

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

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

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

#endif

-- VVV Prop "restriction-caps"
   -- Type: TInterface (Name {namespace = "Gst", name = "Caps"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@restriction-caps@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' encodingProfile #restrictionCaps
-- @
getEncodingProfileRestrictionCaps :: (MonadIO m, IsEncodingProfile o) => o -> m (Maybe Gst.Caps.Caps)
getEncodingProfileRestrictionCaps :: o -> m (Maybe Caps)
getEncodingProfileRestrictionCaps o
obj = IO (Maybe Caps) -> m (Maybe Caps)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Caps) -> m (Maybe Caps))
-> IO (Maybe Caps) -> m (Maybe Caps)
forall a b. (a -> b) -> a -> b
$ o -> String -> (ManagedPtr Caps -> Caps) -> IO (Maybe Caps)
forall a b.
(GObject a, GBoxed b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyBoxed o
obj String
"restriction-caps" ManagedPtr Caps -> Caps
Gst.Caps.Caps

-- | Set the value of the “@restriction-caps@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' encodingProfile [ #restrictionCaps 'Data.GI.Base.Attributes.:=' value ]
-- @
setEncodingProfileRestrictionCaps :: (MonadIO m, IsEncodingProfile o) => o -> Gst.Caps.Caps -> m ()
setEncodingProfileRestrictionCaps :: o -> Caps -> m ()
setEncodingProfileRestrictionCaps o
obj Caps
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Caps -> IO ()
forall a b.
(GObject a, GBoxed b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyBoxed o
obj String
"restriction-caps" (Caps -> Maybe Caps
forall a. a -> Maybe a
Just Caps
val)

-- | Construct a `GValueConstruct` with valid value for the “@restriction-caps@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructEncodingProfileRestrictionCaps :: (IsEncodingProfile o, MIO.MonadIO m) => Gst.Caps.Caps -> m (GValueConstruct o)
constructEncodingProfileRestrictionCaps :: Caps -> m (GValueConstruct o)
constructEncodingProfileRestrictionCaps Caps
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Caps -> IO (GValueConstruct o)
forall a o. GBoxed a => String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBoxed String
"restriction-caps" (Caps -> Maybe Caps
forall a. a -> Maybe a
P.Just Caps
val)

-- | Set the value of the “@restriction-caps@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #restrictionCaps
-- @
clearEncodingProfileRestrictionCaps :: (MonadIO m, IsEncodingProfile o) => o -> m ()
clearEncodingProfileRestrictionCaps :: o -> m ()
clearEncodingProfileRestrictionCaps o
obj = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Caps -> IO ()
forall a b.
(GObject a, GBoxed b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyBoxed o
obj String
"restriction-caps" (Maybe Caps
forall a. Maybe a
Nothing :: Maybe Gst.Caps.Caps)

#if defined(ENABLE_OVERLOADING)
data EncodingProfileRestrictionCapsPropertyInfo
instance AttrInfo EncodingProfileRestrictionCapsPropertyInfo where
    type AttrAllowedOps EncodingProfileRestrictionCapsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint EncodingProfileRestrictionCapsPropertyInfo = IsEncodingProfile
    type AttrSetTypeConstraint EncodingProfileRestrictionCapsPropertyInfo = (~) Gst.Caps.Caps
    type AttrTransferTypeConstraint EncodingProfileRestrictionCapsPropertyInfo = (~) Gst.Caps.Caps
    type AttrTransferType EncodingProfileRestrictionCapsPropertyInfo = Gst.Caps.Caps
    type AttrGetType EncodingProfileRestrictionCapsPropertyInfo = (Maybe Gst.Caps.Caps)
    type AttrLabel EncodingProfileRestrictionCapsPropertyInfo = "restriction-caps"
    type AttrOrigin EncodingProfileRestrictionCapsPropertyInfo = EncodingProfile
    attrGet = getEncodingProfileRestrictionCaps
    attrSet = setEncodingProfileRestrictionCaps
    attrTransfer _ v = do
        return v
    attrConstruct = constructEncodingProfileRestrictionCaps
    attrClear = clearEncodingProfileRestrictionCaps
#endif

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

#if defined(ENABLE_OVERLOADING)
encodingProfileRestrictionCaps :: AttrLabelProxy "restrictionCaps"
encodingProfileRestrictionCaps = AttrLabelProxy

#endif

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

#endif

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

foreign import ccall "gst_encoding_profile_copy" gst_encoding_profile_copy :: 
    Ptr EncodingProfile ->                  -- self : TInterface (Name {namespace = "GstPbutils", name = "EncodingProfile"})
    IO (Ptr EncodingProfile)

-- | Makes a deep copy of /@self@/
-- 
-- /Since: 1.12/
encodingProfileCopy ::
    (B.CallStack.HasCallStack, MonadIO m, IsEncodingProfile a) =>
    a
    -- ^ /@self@/: The t'GI.GstPbutils.Objects.EncodingProfile.EncodingProfile' to copy
    -> m EncodingProfile
    -- ^ __Returns:__ The copy of /@self@/
encodingProfileCopy :: a -> m EncodingProfile
encodingProfileCopy a
self = 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 EncodingProfile
self' <- a -> IO (Ptr EncodingProfile)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr EncodingProfile
result <- Ptr EncodingProfile -> IO (Ptr EncodingProfile)
gst_encoding_profile_copy Ptr EncodingProfile
self'
    Text -> Ptr EncodingProfile -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"encodingProfileCopy" Ptr EncodingProfile
result
    EncodingProfile
result' <- ((ManagedPtr EncodingProfile -> EncodingProfile)
-> Ptr EncodingProfile -> IO EncodingProfile
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr EncodingProfile -> EncodingProfile
EncodingProfile) Ptr EncodingProfile
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    EncodingProfile -> IO EncodingProfile
forall (m :: * -> *) a. Monad m => a -> m a
return EncodingProfile
result'

#if defined(ENABLE_OVERLOADING)
data EncodingProfileCopyMethodInfo
instance (signature ~ (m EncodingProfile), MonadIO m, IsEncodingProfile a) => O.MethodInfo EncodingProfileCopyMethodInfo a signature where
    overloadedMethod = encodingProfileCopy

#endif

-- method EncodingProfile::get_allow_dynamic_output
-- method type : OrdinaryMethod
-- Args: [ 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_profile_get_allow_dynamic_output" gst_encoding_profile_get_allow_dynamic_output :: 
    Ptr EncodingProfile ->                  -- profile : TInterface (Name {namespace = "GstPbutils", name = "EncodingProfile"})
    IO CInt

-- | Get whether the format that has been negotiated in at some point can be renegotiated
-- later during the encoding.
encodingProfileGetAllowDynamicOutput ::
    (B.CallStack.HasCallStack, MonadIO m, IsEncodingProfile a) =>
    a
    -- ^ /@profile@/: a t'GI.GstPbutils.Objects.EncodingProfile.EncodingProfile'
    -> m Bool
encodingProfileGetAllowDynamicOutput :: a -> m Bool
encodingProfileGetAllowDynamicOutput a
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 EncodingProfile
profile' <- a -> IO (Ptr EncodingProfile)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
profile
    CInt
result <- Ptr EncodingProfile -> IO CInt
gst_encoding_profile_get_allow_dynamic_output 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
profile
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data EncodingProfileGetAllowDynamicOutputMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsEncodingProfile a) => O.MethodInfo EncodingProfileGetAllowDynamicOutputMethodInfo a signature where
    overloadedMethod = encodingProfileGetAllowDynamicOutput

#endif

-- method EncodingProfile::get_description
-- method type : OrdinaryMethod
-- Args: [ 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 TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "gst_encoding_profile_get_description" gst_encoding_profile_get_description :: 
    Ptr EncodingProfile ->                  -- profile : TInterface (Name {namespace = "GstPbutils", name = "EncodingProfile"})
    IO CString

-- | /No description available in the introspection data./
encodingProfileGetDescription ::
    (B.CallStack.HasCallStack, MonadIO m, IsEncodingProfile a) =>
    a
    -- ^ /@profile@/: a t'GI.GstPbutils.Objects.EncodingProfile.EncodingProfile'
    -> m T.Text
    -- ^ __Returns:__ the description of the profile, can be 'P.Nothing'.
encodingProfileGetDescription :: a -> m Text
encodingProfileGetDescription a
profile = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr EncodingProfile
profile' <- a -> IO (Ptr EncodingProfile)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
profile
    CString
result <- Ptr EncodingProfile -> IO CString
gst_encoding_profile_get_description Ptr EncodingProfile
profile'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"encodingProfileGetDescription" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
profile
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data EncodingProfileGetDescriptionMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsEncodingProfile a) => O.MethodInfo EncodingProfileGetDescriptionMethodInfo a signature where
    overloadedMethod = encodingProfileGetDescription

#endif

-- method EncodingProfile::get_file_extension
-- method type : OrdinaryMethod
-- Args: [ 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 TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "gst_encoding_profile_get_file_extension" gst_encoding_profile_get_file_extension :: 
    Ptr EncodingProfile ->                  -- profile : TInterface (Name {namespace = "GstPbutils", name = "EncodingProfile"})
    IO CString

-- | /No description available in the introspection data./
encodingProfileGetFileExtension ::
    (B.CallStack.HasCallStack, MonadIO m, IsEncodingProfile a) =>
    a
    -- ^ /@profile@/: a t'GI.GstPbutils.Objects.EncodingProfile.EncodingProfile'
    -> m T.Text
    -- ^ __Returns:__ a suitable file extension for /@profile@/, or NULL.
encodingProfileGetFileExtension :: a -> m Text
encodingProfileGetFileExtension a
profile = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr EncodingProfile
profile' <- a -> IO (Ptr EncodingProfile)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
profile
    CString
result <- Ptr EncodingProfile -> IO CString
gst_encoding_profile_get_file_extension Ptr EncodingProfile
profile'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"encodingProfileGetFileExtension" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
profile
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data EncodingProfileGetFileExtensionMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsEncodingProfile a) => O.MethodInfo EncodingProfileGetFileExtensionMethodInfo a signature where
    overloadedMethod = encodingProfileGetFileExtension

#endif

-- method EncodingProfile::get_format
-- method type : OrdinaryMethod
-- Args: [ 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 (TInterface Name { namespace = "Gst" , name = "Caps" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_encoding_profile_get_format" gst_encoding_profile_get_format :: 
    Ptr EncodingProfile ->                  -- profile : TInterface (Name {namespace = "GstPbutils", name = "EncodingProfile"})
    IO (Ptr Gst.Caps.Caps)

-- | /No description available in the introspection data./
encodingProfileGetFormat ::
    (B.CallStack.HasCallStack, MonadIO m, IsEncodingProfile a) =>
    a
    -- ^ /@profile@/: a t'GI.GstPbutils.Objects.EncodingProfile.EncodingProfile'
    -> m Gst.Caps.Caps
    -- ^ __Returns:__ the t'GI.Gst.Structs.Caps.Caps' corresponding to the media format used
    -- in the profile. Unref after usage.
encodingProfileGetFormat :: a -> m Caps
encodingProfileGetFormat a
profile = IO Caps -> m Caps
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Caps -> m Caps) -> IO Caps -> m Caps
forall a b. (a -> b) -> a -> b
$ do
    Ptr EncodingProfile
profile' <- a -> IO (Ptr EncodingProfile)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
profile
    Ptr Caps
result <- Ptr EncodingProfile -> IO (Ptr Caps)
gst_encoding_profile_get_format Ptr EncodingProfile
profile'
    Text -> Ptr Caps -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"encodingProfileGetFormat" Ptr Caps
result
    Caps
result' <- ((ManagedPtr Caps -> Caps) -> Ptr Caps -> IO Caps
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Caps -> Caps
Gst.Caps.Caps) Ptr Caps
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
profile
    Caps -> IO Caps
forall (m :: * -> *) a. Monad m => a -> m a
return Caps
result'

#if defined(ENABLE_OVERLOADING)
data EncodingProfileGetFormatMethodInfo
instance (signature ~ (m Gst.Caps.Caps), MonadIO m, IsEncodingProfile a) => O.MethodInfo EncodingProfileGetFormatMethodInfo a signature where
    overloadedMethod = encodingProfileGetFormat

#endif

-- method EncodingProfile::get_input_caps
-- method type : OrdinaryMethod
-- Args: [ 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 (TInterface Name { namespace = "Gst" , name = "Caps" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_encoding_profile_get_input_caps" gst_encoding_profile_get_input_caps :: 
    Ptr EncodingProfile ->                  -- profile : TInterface (Name {namespace = "GstPbutils", name = "EncodingProfile"})
    IO (Ptr Gst.Caps.Caps)

-- | Computes the full output caps that this /@profile@/ will be able to consume.
encodingProfileGetInputCaps ::
    (B.CallStack.HasCallStack, MonadIO m, IsEncodingProfile a) =>
    a
    -- ^ /@profile@/: a t'GI.GstPbutils.Objects.EncodingProfile.EncodingProfile'
    -> m Gst.Caps.Caps
    -- ^ __Returns:__ The full caps the given /@profile@/ can consume. Call
    -- @/gst_caps_unref()/@ when you are done with the caps.
encodingProfileGetInputCaps :: a -> m Caps
encodingProfileGetInputCaps a
profile = IO Caps -> m Caps
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Caps -> m Caps) -> IO Caps -> m Caps
forall a b. (a -> b) -> a -> b
$ do
    Ptr EncodingProfile
profile' <- a -> IO (Ptr EncodingProfile)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
profile
    Ptr Caps
result <- Ptr EncodingProfile -> IO (Ptr Caps)
gst_encoding_profile_get_input_caps Ptr EncodingProfile
profile'
    Text -> Ptr Caps -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"encodingProfileGetInputCaps" Ptr Caps
result
    Caps
result' <- ((ManagedPtr Caps -> Caps) -> Ptr Caps -> IO Caps
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Caps -> Caps
Gst.Caps.Caps) Ptr Caps
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
profile
    Caps -> IO Caps
forall (m :: * -> *) a. Monad m => a -> m a
return Caps
result'

#if defined(ENABLE_OVERLOADING)
data EncodingProfileGetInputCapsMethodInfo
instance (signature ~ (m Gst.Caps.Caps), MonadIO m, IsEncodingProfile a) => O.MethodInfo EncodingProfileGetInputCapsMethodInfo a signature where
    overloadedMethod = encodingProfileGetInputCaps

#endif

-- method EncodingProfile::get_name
-- method type : OrdinaryMethod
-- Args: [ 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 TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "gst_encoding_profile_get_name" gst_encoding_profile_get_name :: 
    Ptr EncodingProfile ->                  -- profile : TInterface (Name {namespace = "GstPbutils", name = "EncodingProfile"})
    IO CString

-- | /No description available in the introspection data./
encodingProfileGetName ::
    (B.CallStack.HasCallStack, MonadIO m, IsEncodingProfile a) =>
    a
    -- ^ /@profile@/: a t'GI.GstPbutils.Objects.EncodingProfile.EncodingProfile'
    -> m T.Text
    -- ^ __Returns:__ the name of the profile, can be 'P.Nothing'.
encodingProfileGetName :: a -> m Text
encodingProfileGetName a
profile = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr EncodingProfile
profile' <- a -> IO (Ptr EncodingProfile)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
profile
    CString
result <- Ptr EncodingProfile -> IO CString
gst_encoding_profile_get_name Ptr EncodingProfile
profile'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"encodingProfileGetName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
profile
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data EncodingProfileGetNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsEncodingProfile a) => O.MethodInfo EncodingProfileGetNameMethodInfo a signature where
    overloadedMethod = encodingProfileGetName

#endif

-- method EncodingProfile::get_presence
-- method type : OrdinaryMethod
-- Args: [ 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 TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "gst_encoding_profile_get_presence" gst_encoding_profile_get_presence :: 
    Ptr EncodingProfile ->                  -- profile : TInterface (Name {namespace = "GstPbutils", name = "EncodingProfile"})
    IO Word32

-- | /No description available in the introspection data./
encodingProfileGetPresence ::
    (B.CallStack.HasCallStack, MonadIO m, IsEncodingProfile a) =>
    a
    -- ^ /@profile@/: a t'GI.GstPbutils.Objects.EncodingProfile.EncodingProfile'
    -> m Word32
    -- ^ __Returns:__ The number of times the profile is used in its parent
    -- container profile. If 0, it is not a mandatory stream.
encodingProfileGetPresence :: a -> m Word32
encodingProfileGetPresence a
profile = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr EncodingProfile
profile' <- a -> IO (Ptr EncodingProfile)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
profile
    Word32
result <- Ptr EncodingProfile -> IO Word32
gst_encoding_profile_get_presence Ptr EncodingProfile
profile'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
profile
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data EncodingProfileGetPresenceMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsEncodingProfile a) => O.MethodInfo EncodingProfileGetPresenceMethodInfo a signature where
    overloadedMethod = encodingProfileGetPresence

#endif

-- method EncodingProfile::get_preset
-- method type : OrdinaryMethod
-- Args: [ 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 TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "gst_encoding_profile_get_preset" gst_encoding_profile_get_preset :: 
    Ptr EncodingProfile ->                  -- profile : TInterface (Name {namespace = "GstPbutils", name = "EncodingProfile"})
    IO CString

-- | /No description available in the introspection data./
encodingProfileGetPreset ::
    (B.CallStack.HasCallStack, MonadIO m, IsEncodingProfile a) =>
    a
    -- ^ /@profile@/: a t'GI.GstPbutils.Objects.EncodingProfile.EncodingProfile'
    -> m T.Text
    -- ^ __Returns:__ the name of the t'GI.Gst.Interfaces.Preset.Preset' to be used in the profile.
    -- This is the name that has been set when saving the preset.
encodingProfileGetPreset :: a -> m Text
encodingProfileGetPreset a
profile = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr EncodingProfile
profile' <- a -> IO (Ptr EncodingProfile)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
profile
    CString
result <- Ptr EncodingProfile -> IO CString
gst_encoding_profile_get_preset Ptr EncodingProfile
profile'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"encodingProfileGetPreset" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
profile
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data EncodingProfileGetPresetMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsEncodingProfile a) => O.MethodInfo EncodingProfileGetPresetMethodInfo a signature where
    overloadedMethod = encodingProfileGetPreset

#endif

-- method EncodingProfile::get_preset_name
-- method type : OrdinaryMethod
-- Args: [ 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 TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "gst_encoding_profile_get_preset_name" gst_encoding_profile_get_preset_name :: 
    Ptr EncodingProfile ->                  -- profile : TInterface (Name {namespace = "GstPbutils", name = "EncodingProfile"})
    IO CString

-- | /No description available in the introspection data./
encodingProfileGetPresetName ::
    (B.CallStack.HasCallStack, MonadIO m, IsEncodingProfile a) =>
    a
    -- ^ /@profile@/: a t'GI.GstPbutils.Objects.EncodingProfile.EncodingProfile'
    -> m T.Text
    -- ^ __Returns:__ the name of the t'GI.Gst.Interfaces.Preset.Preset' factory to be used in the profile.
encodingProfileGetPresetName :: a -> m Text
encodingProfileGetPresetName a
profile = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr EncodingProfile
profile' <- a -> IO (Ptr EncodingProfile)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
profile
    CString
result <- Ptr EncodingProfile -> IO CString
gst_encoding_profile_get_preset_name Ptr EncodingProfile
profile'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"encodingProfileGetPresetName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
profile
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data EncodingProfileGetPresetNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsEncodingProfile a) => O.MethodInfo EncodingProfileGetPresetNameMethodInfo a signature where
    overloadedMethod = encodingProfileGetPresetName

#endif

-- method EncodingProfile::get_restriction
-- method type : OrdinaryMethod
-- Args: [ 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 (TInterface Name { namespace = "Gst" , name = "Caps" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_encoding_profile_get_restriction" gst_encoding_profile_get_restriction :: 
    Ptr EncodingProfile ->                  -- profile : TInterface (Name {namespace = "GstPbutils", name = "EncodingProfile"})
    IO (Ptr Gst.Caps.Caps)

-- | /No description available in the introspection data./
encodingProfileGetRestriction ::
    (B.CallStack.HasCallStack, MonadIO m, IsEncodingProfile a) =>
    a
    -- ^ /@profile@/: a t'GI.GstPbutils.Objects.EncodingProfile.EncodingProfile'
    -> m Gst.Caps.Caps
    -- ^ __Returns:__ The restriction t'GI.Gst.Structs.Caps.Caps' to apply before the encoder
    -- that will be used in the profile. The fields present in restriction caps are
    -- properties of the raw stream (that is before encoding), such as height and
    -- width for video and depth and sampling rate for audio. Does not apply to
    -- t'GI.GstPbutils.Objects.EncodingContainerProfile.EncodingContainerProfile' (since there is no corresponding raw stream).
    -- Can be 'P.Nothing'. Unref after usage.
encodingProfileGetRestriction :: a -> m Caps
encodingProfileGetRestriction a
profile = IO Caps -> m Caps
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Caps -> m Caps) -> IO Caps -> m Caps
forall a b. (a -> b) -> a -> b
$ do
    Ptr EncodingProfile
profile' <- a -> IO (Ptr EncodingProfile)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
profile
    Ptr Caps
result <- Ptr EncodingProfile -> IO (Ptr Caps)
gst_encoding_profile_get_restriction Ptr EncodingProfile
profile'
    Text -> Ptr Caps -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"encodingProfileGetRestriction" Ptr Caps
result
    Caps
result' <- ((ManagedPtr Caps -> Caps) -> Ptr Caps -> IO Caps
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Caps -> Caps
Gst.Caps.Caps) Ptr Caps
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
profile
    Caps -> IO Caps
forall (m :: * -> *) a. Monad m => a -> m a
return Caps
result'

#if defined(ENABLE_OVERLOADING)
data EncodingProfileGetRestrictionMethodInfo
instance (signature ~ (m Gst.Caps.Caps), MonadIO m, IsEncodingProfile a) => O.MethodInfo EncodingProfileGetRestrictionMethodInfo a signature where
    overloadedMethod = encodingProfileGetRestriction

#endif

-- method EncodingProfile::get_type_nick
-- method type : OrdinaryMethod
-- Args: [ 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 TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "gst_encoding_profile_get_type_nick" gst_encoding_profile_get_type_nick :: 
    Ptr EncodingProfile ->                  -- profile : TInterface (Name {namespace = "GstPbutils", name = "EncodingProfile"})
    IO CString

-- | /No description available in the introspection data./
encodingProfileGetTypeNick ::
    (B.CallStack.HasCallStack, MonadIO m, IsEncodingProfile a) =>
    a
    -- ^ /@profile@/: a t'GI.GstPbutils.Objects.EncodingProfile.EncodingProfile'
    -> m T.Text
    -- ^ __Returns:__ the human-readable name of the type of /@profile@/.
encodingProfileGetTypeNick :: a -> m Text
encodingProfileGetTypeNick a
profile = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr EncodingProfile
profile' <- a -> IO (Ptr EncodingProfile)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
profile
    CString
result <- Ptr EncodingProfile -> IO CString
gst_encoding_profile_get_type_nick Ptr EncodingProfile
profile'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"encodingProfileGetTypeNick" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
profile
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data EncodingProfileGetTypeNickMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsEncodingProfile a) => O.MethodInfo EncodingProfileGetTypeNickMethodInfo a signature where
    overloadedMethod = encodingProfileGetTypeNick

#endif

-- method EncodingProfile::is_enabled
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "profile"
--           , argType =
--               TInterface
--                 Name { namespace = "GstPbutils" , name = "EncodingProfile" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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_profile_is_enabled" gst_encoding_profile_is_enabled :: 
    Ptr EncodingProfile ->                  -- profile : TInterface (Name {namespace = "GstPbutils", name = "EncodingProfile"})
    IO CInt

-- | /No description available in the introspection data./
encodingProfileIsEnabled ::
    (B.CallStack.HasCallStack, MonadIO m, IsEncodingProfile a) =>
    a
    -> m Bool
encodingProfileIsEnabled :: a -> m Bool
encodingProfileIsEnabled a
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 EncodingProfile
profile' <- a -> IO (Ptr EncodingProfile)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
profile
    CInt
result <- Ptr EncodingProfile -> IO CInt
gst_encoding_profile_is_enabled 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
profile
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data EncodingProfileIsEnabledMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsEncodingProfile a) => O.MethodInfo EncodingProfileIsEnabledMethodInfo a signature where
    overloadedMethod = encodingProfileIsEnabled

#endif

-- method EncodingProfile::is_equal
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "a"
--           , 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
--           }
--       , Arg
--           { argCName = "b"
--           , 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_profile_is_equal" gst_encoding_profile_is_equal :: 
    Ptr EncodingProfile ->                  -- a : TInterface (Name {namespace = "GstPbutils", name = "EncodingProfile"})
    Ptr EncodingProfile ->                  -- b : TInterface (Name {namespace = "GstPbutils", name = "EncodingProfile"})
    IO CInt

-- | Checks whether the two t'GI.GstPbutils.Objects.EncodingProfile.EncodingProfile' are equal
encodingProfileIsEqual ::
    (B.CallStack.HasCallStack, MonadIO m, IsEncodingProfile a, IsEncodingProfile b) =>
    a
    -- ^ /@a@/: a t'GI.GstPbutils.Objects.EncodingProfile.EncodingProfile'
    -> b
    -- ^ /@b@/: a t'GI.GstPbutils.Objects.EncodingProfile.EncodingProfile'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@a@/ and /@b@/ are equal, else 'P.False'.
encodingProfileIsEqual :: a -> b -> m Bool
encodingProfileIsEqual a
a b
b = 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 EncodingProfile
a' <- a -> IO (Ptr EncodingProfile)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
a
    Ptr EncodingProfile
b' <- b -> IO (Ptr EncodingProfile)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
b
    CInt
result <- Ptr EncodingProfile -> Ptr EncodingProfile -> IO CInt
gst_encoding_profile_is_equal Ptr EncodingProfile
a' Ptr EncodingProfile
b'
    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
a
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
b
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data EncodingProfileIsEqualMethodInfo
instance (signature ~ (b -> m Bool), MonadIO m, IsEncodingProfile a, IsEncodingProfile b) => O.MethodInfo EncodingProfileIsEqualMethodInfo a signature where
    overloadedMethod = encodingProfileIsEqual

#endif

-- method EncodingProfile::set_allow_dynamic_output
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "allow_dynamic_output"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Whether the format that has been negotiated first can be renegotiated\nduring the encoding"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_encoding_profile_set_allow_dynamic_output" gst_encoding_profile_set_allow_dynamic_output :: 
    Ptr EncodingProfile ->                  -- profile : TInterface (Name {namespace = "GstPbutils", name = "EncodingProfile"})
    CInt ->                                 -- allow_dynamic_output : TBasicType TBoolean
    IO ()

-- | Sets whether the format that has been negotiated in at some point can be renegotiated
-- later during the encoding.
encodingProfileSetAllowDynamicOutput ::
    (B.CallStack.HasCallStack, MonadIO m, IsEncodingProfile a) =>
    a
    -- ^ /@profile@/: a t'GI.GstPbutils.Objects.EncodingProfile.EncodingProfile'
    -> Bool
    -- ^ /@allowDynamicOutput@/: Whether the format that has been negotiated first can be renegotiated
    -- during the encoding
    -> m ()
encodingProfileSetAllowDynamicOutput :: a -> Bool -> m ()
encodingProfileSetAllowDynamicOutput a
profile Bool
allowDynamicOutput = 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 EncodingProfile
profile' <- a -> IO (Ptr EncodingProfile)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
profile
    let allowDynamicOutput' :: CInt
allowDynamicOutput' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
allowDynamicOutput
    Ptr EncodingProfile -> CInt -> IO ()
gst_encoding_profile_set_allow_dynamic_output Ptr EncodingProfile
profile' CInt
allowDynamicOutput'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
profile
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EncodingProfileSetAllowDynamicOutputMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsEncodingProfile a) => O.MethodInfo EncodingProfileSetAllowDynamicOutputMethodInfo a signature where
    overloadedMethod = encodingProfileSetAllowDynamicOutput

#endif

-- method EncodingProfile::set_description
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "description"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the description to set on the profile"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_encoding_profile_set_description" gst_encoding_profile_set_description :: 
    Ptr EncodingProfile ->                  -- profile : TInterface (Name {namespace = "GstPbutils", name = "EncodingProfile"})
    CString ->                              -- description : TBasicType TUTF8
    IO ()

-- | Set /@description@/ as the given description for the /@profile@/. A copy of
-- /@description@/ will be made internally.
encodingProfileSetDescription ::
    (B.CallStack.HasCallStack, MonadIO m, IsEncodingProfile a) =>
    a
    -- ^ /@profile@/: a t'GI.GstPbutils.Objects.EncodingProfile.EncodingProfile'
    -> Maybe (T.Text)
    -- ^ /@description@/: the description to set on the profile
    -> m ()
encodingProfileSetDescription :: a -> Maybe Text -> m ()
encodingProfileSetDescription a
profile Maybe Text
description = 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 EncodingProfile
profile' <- a -> IO (Ptr EncodingProfile)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
profile
    CString
maybeDescription <- case Maybe Text
description of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jDescription -> do
            CString
jDescription' <- Text -> IO CString
textToCString Text
jDescription
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jDescription'
    Ptr EncodingProfile -> CString -> IO ()
gst_encoding_profile_set_description Ptr EncodingProfile
profile' CString
maybeDescription
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
profile
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeDescription
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EncodingProfileSetDescriptionMethodInfo
instance (signature ~ (Maybe (T.Text) -> m ()), MonadIO m, IsEncodingProfile a) => O.MethodInfo EncodingProfileSetDescriptionMethodInfo a signature where
    overloadedMethod = encodingProfileSetDescription

#endif

-- method EncodingProfile::set_enabled
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "enabled"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "%FALSE to disable #profile, %TRUE to enable it"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_encoding_profile_set_enabled" gst_encoding_profile_set_enabled :: 
    Ptr EncodingProfile ->                  -- profile : TInterface (Name {namespace = "GstPbutils", name = "EncodingProfile"})
    CInt ->                                 -- enabled : TBasicType TBoolean
    IO ()

-- | Set whether the profile should be used or not.
-- 
-- /Since: 1.6/
encodingProfileSetEnabled ::
    (B.CallStack.HasCallStack, MonadIO m, IsEncodingProfile a) =>
    a
    -- ^ /@profile@/: a t'GI.GstPbutils.Objects.EncodingProfile.EncodingProfile'
    -> Bool
    -- ^ /@enabled@/: 'P.False' to disable @/profile/@, 'P.True' to enable it
    -> m ()
encodingProfileSetEnabled :: a -> Bool -> m ()
encodingProfileSetEnabled a
profile Bool
enabled = 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 EncodingProfile
profile' <- a -> IO (Ptr EncodingProfile)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
profile
    let enabled' :: CInt
enabled' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
enabled
    Ptr EncodingProfile -> CInt -> IO ()
gst_encoding_profile_set_enabled Ptr EncodingProfile
profile' CInt
enabled'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
profile
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EncodingProfileSetEnabledMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsEncodingProfile a) => O.MethodInfo EncodingProfileSetEnabledMethodInfo a signature where
    overloadedMethod = encodingProfileSetEnabled

#endif

-- method EncodingProfile::set_format
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the media format to use in the profile."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_encoding_profile_set_format" gst_encoding_profile_set_format :: 
    Ptr EncodingProfile ->                  -- profile : TInterface (Name {namespace = "GstPbutils", name = "EncodingProfile"})
    Ptr Gst.Caps.Caps ->                    -- format : TInterface (Name {namespace = "Gst", name = "Caps"})
    IO ()

-- | Sets the media format used in the profile.
encodingProfileSetFormat ::
    (B.CallStack.HasCallStack, MonadIO m, IsEncodingProfile a) =>
    a
    -- ^ /@profile@/: a t'GI.GstPbutils.Objects.EncodingProfile.EncodingProfile'
    -> Gst.Caps.Caps
    -- ^ /@format@/: the media format to use in the profile.
    -> m ()
encodingProfileSetFormat :: a -> Caps -> m ()
encodingProfileSetFormat a
profile Caps
format = 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 EncodingProfile
profile' <- a -> IO (Ptr EncodingProfile)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
profile
    Ptr Caps
format' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
format
    Ptr EncodingProfile -> Ptr Caps -> IO ()
gst_encoding_profile_set_format Ptr EncodingProfile
profile' Ptr Caps
format'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
profile
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
format
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EncodingProfileSetFormatMethodInfo
instance (signature ~ (Gst.Caps.Caps -> m ()), MonadIO m, IsEncodingProfile a) => O.MethodInfo EncodingProfileSetFormatMethodInfo a signature where
    overloadedMethod = encodingProfileSetFormat

#endif

-- method EncodingProfile::set_name
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name to set on the profile"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_encoding_profile_set_name" gst_encoding_profile_set_name :: 
    Ptr EncodingProfile ->                  -- profile : TInterface (Name {namespace = "GstPbutils", name = "EncodingProfile"})
    CString ->                              -- name : TBasicType TUTF8
    IO ()

-- | Set /@name@/ as the given name for the /@profile@/. A copy of /@name@/ will be made
-- internally.
encodingProfileSetName ::
    (B.CallStack.HasCallStack, MonadIO m, IsEncodingProfile a) =>
    a
    -- ^ /@profile@/: a t'GI.GstPbutils.Objects.EncodingProfile.EncodingProfile'
    -> Maybe (T.Text)
    -- ^ /@name@/: the name to set on the profile
    -> m ()
encodingProfileSetName :: a -> Maybe Text -> m ()
encodingProfileSetName a
profile Maybe Text
name = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr EncodingProfile
profile' <- a -> IO (Ptr EncodingProfile)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
profile
    CString
maybeName <- case Maybe Text
name of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jName -> do
            CString
jName' <- Text -> IO CString
textToCString Text
jName
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jName'
    Ptr EncodingProfile -> CString -> IO ()
gst_encoding_profile_set_name Ptr EncodingProfile
profile' CString
maybeName
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
profile
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeName
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EncodingProfileSetNameMethodInfo
instance (signature ~ (Maybe (T.Text) -> m ()), MonadIO m, IsEncodingProfile a) => O.MethodInfo EncodingProfileSetNameMethodInfo a signature where
    overloadedMethod = encodingProfileSetName

#endif

-- method EncodingProfile::set_presence
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "presence"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of time the profile can be used"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_encoding_profile_set_presence" gst_encoding_profile_set_presence :: 
    Ptr EncodingProfile ->                  -- profile : TInterface (Name {namespace = "GstPbutils", name = "EncodingProfile"})
    Word32 ->                               -- presence : TBasicType TUInt
    IO ()

-- | Set the number of time the profile is used in its parent
-- container profile. If 0, it is not a mandatory stream
encodingProfileSetPresence ::
    (B.CallStack.HasCallStack, MonadIO m, IsEncodingProfile a) =>
    a
    -- ^ /@profile@/: a t'GI.GstPbutils.Objects.EncodingProfile.EncodingProfile'
    -> Word32
    -- ^ /@presence@/: the number of time the profile can be used
    -> m ()
encodingProfileSetPresence :: a -> Word32 -> m ()
encodingProfileSetPresence a
profile Word32
presence = 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 EncodingProfile
profile' <- a -> IO (Ptr EncodingProfile)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
profile
    Ptr EncodingProfile -> Word32 -> IO ()
gst_encoding_profile_set_presence Ptr EncodingProfile
profile' Word32
presence
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
profile
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EncodingProfileSetPresenceMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m, IsEncodingProfile a) => O.MethodInfo EncodingProfileSetPresenceMethodInfo a signature where
    overloadedMethod = encodingProfileSetPresence

#endif

-- method EncodingProfile::set_preset
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "preset"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the element preset to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_encoding_profile_set_preset" gst_encoding_profile_set_preset :: 
    Ptr EncodingProfile ->                  -- profile : TInterface (Name {namespace = "GstPbutils", name = "EncodingProfile"})
    CString ->                              -- preset : TBasicType TUTF8
    IO ()

-- | Sets the name of the t'GI.Gst.Objects.Element.Element' that implements the t'GI.Gst.Interfaces.Preset.Preset' interface
-- to use for the profile.
-- This is the name that has been set when saving the preset.
encodingProfileSetPreset ::
    (B.CallStack.HasCallStack, MonadIO m, IsEncodingProfile a) =>
    a
    -- ^ /@profile@/: a t'GI.GstPbutils.Objects.EncodingProfile.EncodingProfile'
    -> Maybe (T.Text)
    -- ^ /@preset@/: the element preset to use
    -> m ()
encodingProfileSetPreset :: a -> Maybe Text -> m ()
encodingProfileSetPreset a
profile Maybe Text
preset = 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 EncodingProfile
profile' <- a -> IO (Ptr EncodingProfile)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
profile
    CString
maybePreset <- case Maybe Text
preset of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jPreset -> do
            CString
jPreset' <- Text -> IO CString
textToCString Text
jPreset
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jPreset'
    Ptr EncodingProfile -> CString -> IO ()
gst_encoding_profile_set_preset Ptr EncodingProfile
profile' CString
maybePreset
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
profile
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybePreset
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EncodingProfileSetPresetMethodInfo
instance (signature ~ (Maybe (T.Text) -> m ()), MonadIO m, IsEncodingProfile a) => O.MethodInfo EncodingProfileSetPresetMethodInfo a signature where
    overloadedMethod = encodingProfileSetPreset

#endif

-- method EncodingProfile::set_preset_name
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "preset_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The name of the preset to use in this @profile."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_encoding_profile_set_preset_name" gst_encoding_profile_set_preset_name :: 
    Ptr EncodingProfile ->                  -- profile : TInterface (Name {namespace = "GstPbutils", name = "EncodingProfile"})
    CString ->                              -- preset_name : TBasicType TUTF8
    IO ()

-- | Sets the name of the t'GI.Gst.Interfaces.Preset.Preset'\'s factory to be used in the profile.
encodingProfileSetPresetName ::
    (B.CallStack.HasCallStack, MonadIO m, IsEncodingProfile a) =>
    a
    -- ^ /@profile@/: a t'GI.GstPbutils.Objects.EncodingProfile.EncodingProfile'
    -> Maybe (T.Text)
    -- ^ /@presetName@/: The name of the preset to use in this /@profile@/.
    -> m ()
encodingProfileSetPresetName :: a -> Maybe Text -> m ()
encodingProfileSetPresetName a
profile Maybe Text
presetName = 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 EncodingProfile
profile' <- a -> IO (Ptr EncodingProfile)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
profile
    CString
maybePresetName <- case Maybe Text
presetName of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jPresetName -> do
            CString
jPresetName' <- Text -> IO CString
textToCString Text
jPresetName
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jPresetName'
    Ptr EncodingProfile -> CString -> IO ()
gst_encoding_profile_set_preset_name Ptr EncodingProfile
profile' CString
maybePresetName
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
profile
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybePresetName
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EncodingProfileSetPresetNameMethodInfo
instance (signature ~ (Maybe (T.Text) -> m ()), MonadIO m, IsEncodingProfile a) => O.MethodInfo EncodingProfileSetPresetNameMethodInfo a signature where
    overloadedMethod = encodingProfileSetPresetName

#endif

-- method EncodingProfile::set_restriction
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "restriction"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the restriction to apply"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_encoding_profile_set_restriction" gst_encoding_profile_set_restriction :: 
    Ptr EncodingProfile ->                  -- profile : TInterface (Name {namespace = "GstPbutils", name = "EncodingProfile"})
    Ptr Gst.Caps.Caps ->                    -- restriction : TInterface (Name {namespace = "Gst", name = "Caps"})
    IO ()

-- | Set the restriction t'GI.Gst.Structs.Caps.Caps' to apply before the encoder
-- that will be used in the profile. See 'GI.GstPbutils.Objects.EncodingProfile.encodingProfileGetRestriction'
-- for more about restrictions. Does not apply to t'GI.GstPbutils.Objects.EncodingContainerProfile.EncodingContainerProfile'.
encodingProfileSetRestriction ::
    (B.CallStack.HasCallStack, MonadIO m, IsEncodingProfile a) =>
    a
    -- ^ /@profile@/: a t'GI.GstPbutils.Objects.EncodingProfile.EncodingProfile'
    -> Maybe (Gst.Caps.Caps)
    -- ^ /@restriction@/: the restriction to apply
    -> m ()
encodingProfileSetRestriction :: a -> Maybe Caps -> m ()
encodingProfileSetRestriction a
profile Maybe Caps
restriction = 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 EncodingProfile
profile' <- a -> IO (Ptr EncodingProfile)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
profile
    Ptr Caps
maybeRestriction <- case Maybe Caps
restriction of
        Maybe Caps
Nothing -> Ptr Caps -> IO (Ptr Caps)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Caps
forall a. Ptr a
nullPtr
        Just Caps
jRestriction -> do
            Ptr Caps
jRestriction' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Caps
jRestriction
            Ptr Caps -> IO (Ptr Caps)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Caps
jRestriction'
    Ptr EncodingProfile -> Ptr Caps -> IO ()
gst_encoding_profile_set_restriction Ptr EncodingProfile
profile' Ptr Caps
maybeRestriction
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
profile
    Maybe Caps -> (Caps -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Caps
restriction Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EncodingProfileSetRestrictionMethodInfo
instance (signature ~ (Maybe (Gst.Caps.Caps) -> m ()), MonadIO m, IsEncodingProfile a) => O.MethodInfo EncodingProfileSetRestrictionMethodInfo a signature where
    overloadedMethod = encodingProfileSetRestriction

#endif

-- method EncodingProfile::find
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "targetname"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The name of the target"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "profilename"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The name of the profile, if %NULL\nprovided, it will default to the encoding profile called `default`."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "category"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The target category. Can be %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GstPbutils" , name = "EncodingProfile" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_encoding_profile_find" gst_encoding_profile_find :: 
    CString ->                              -- targetname : TBasicType TUTF8
    CString ->                              -- profilename : TBasicType TUTF8
    CString ->                              -- category : TBasicType TUTF8
    IO (Ptr EncodingProfile)

-- | Find the t'GI.GstPbutils.Objects.EncodingProfile.EncodingProfile' with the specified name and category.
encodingProfileFind ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@targetname@/: The name of the target
    -> Maybe (T.Text)
    -- ^ /@profilename@/: The name of the profile, if 'P.Nothing'
    -- provided, it will default to the encoding profile called @default@.
    -> Maybe (T.Text)
    -- ^ /@category@/: The target category. Can be 'P.Nothing'
    -> m EncodingProfile
    -- ^ __Returns:__ The matching t'GI.GstPbutils.Objects.EncodingProfile.EncodingProfile' or 'P.Nothing'.
encodingProfileFind :: Text -> Maybe Text -> Maybe Text -> m EncodingProfile
encodingProfileFind Text
targetname Maybe Text
profilename Maybe Text
category = 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
    CString
targetname' <- Text -> IO CString
textToCString Text
targetname
    CString
maybeProfilename <- case Maybe Text
profilename of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jProfilename -> do
            CString
jProfilename' <- Text -> IO CString
textToCString Text
jProfilename
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jProfilename'
    CString
maybeCategory <- case Maybe Text
category of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jCategory -> do
            CString
jCategory' <- Text -> IO CString
textToCString Text
jCategory
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jCategory'
    Ptr EncodingProfile
result <- CString -> CString -> CString -> IO (Ptr EncodingProfile)
gst_encoding_profile_find CString
targetname' CString
maybeProfilename CString
maybeCategory
    Text -> Ptr EncodingProfile -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"encodingProfileFind" Ptr EncodingProfile
result
    EncodingProfile
result' <- ((ManagedPtr EncodingProfile -> EncodingProfile)
-> Ptr EncodingProfile -> IO EncodingProfile
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr EncodingProfile -> EncodingProfile
EncodingProfile) Ptr EncodingProfile
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
targetname'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeProfilename
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeCategory
    EncodingProfile -> IO EncodingProfile
forall (m :: * -> *) a. Monad m => a -> m a
return EncodingProfile
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method EncodingProfile::from_discoverer
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface
--                 Name { namespace = "GstPbutils" , name = "DiscovererInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstDiscovererInfo to read from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GstPbutils" , name = "EncodingProfile" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_encoding_profile_from_discoverer" gst_encoding_profile_from_discoverer :: 
    Ptr GstPbutils.DiscovererInfo.DiscovererInfo -> -- info : TInterface (Name {namespace = "GstPbutils", name = "DiscovererInfo"})
    IO (Ptr EncodingProfile)

-- | Creates a t'GI.GstPbutils.Objects.EncodingProfile.EncodingProfile' matching the formats from the given
-- t'GI.GstPbutils.Objects.DiscovererInfo.DiscovererInfo'. Streams other than audio or video (eg,
-- subtitles), are currently ignored.
encodingProfileFromDiscoverer ::
    (B.CallStack.HasCallStack, MonadIO m, GstPbutils.DiscovererInfo.IsDiscovererInfo a) =>
    a
    -- ^ /@info@/: The t'GI.GstPbutils.Objects.DiscovererInfo.DiscovererInfo' to read from
    -> m EncodingProfile
    -- ^ __Returns:__ The new t'GI.GstPbutils.Objects.EncodingProfile.EncodingProfile' or 'P.Nothing'.
encodingProfileFromDiscoverer :: a -> m EncodingProfile
encodingProfileFromDiscoverer a
info = 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 DiscovererInfo
info' <- a -> IO (Ptr DiscovererInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
info
    Ptr EncodingProfile
result <- Ptr DiscovererInfo -> IO (Ptr EncodingProfile)
gst_encoding_profile_from_discoverer Ptr DiscovererInfo
info'
    Text -> Ptr EncodingProfile -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"encodingProfileFromDiscoverer" Ptr EncodingProfile
result
    EncodingProfile
result' <- ((ManagedPtr EncodingProfile -> EncodingProfile)
-> Ptr EncodingProfile -> IO EncodingProfile
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr EncodingProfile -> EncodingProfile
EncodingProfile) Ptr EncodingProfile
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
info
    EncodingProfile -> IO EncodingProfile
forall (m :: * -> *) a. Monad m => a -> m a
return EncodingProfile
result'

#if defined(ENABLE_OVERLOADING)
#endif