{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Variant of t'GI.GstPbutils.Objects.EncodingProfile.EncodingProfile' for video streams, allows specifying the /@pass@/.

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

module GI.GstPbutils.Objects.EncodingVideoProfile
    ( 

-- * Exported types
    EncodingVideoProfile(..)                ,
    IsEncodingVideoProfile                  ,
    toEncodingVideoProfile                  ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveEncodingVideoProfileMethod       ,
#endif

-- ** getPass #method:getPass#

#if defined(ENABLE_OVERLOADING)
    EncodingVideoProfileGetPassMethodInfo   ,
#endif
    encodingVideoProfileGetPass             ,


-- ** getVariableframerate #method:getVariableframerate#

#if defined(ENABLE_OVERLOADING)
    EncodingVideoProfileGetVariableframerateMethodInfo,
#endif
    encodingVideoProfileGetVariableframerate,


-- ** new #method:new#

    encodingVideoProfileNew                 ,


-- ** setPass #method:setPass#

#if defined(ENABLE_OVERLOADING)
    EncodingVideoProfileSetPassMethodInfo   ,
#endif
    encodingVideoProfileSetPass             ,


-- ** setVariableframerate #method:setVariableframerate#

#if defined(ENABLE_OVERLOADING)
    EncodingVideoProfileSetVariableframerateMethodInfo,
#endif
    encodingVideoProfileSetVariableframerate,




    ) where

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

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

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

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

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

foreign import ccall "gst_encoding_video_profile_get_type"
    c_gst_encoding_video_profile_get_type :: IO B.Types.GType

instance B.Types.TypedObject EncodingVideoProfile where
    glibType :: IO GType
glibType = IO GType
c_gst_encoding_video_profile_get_type

instance B.Types.GObject EncodingVideoProfile

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

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

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

-- | Convert 'EncodingVideoProfile' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe EncodingVideoProfile) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gst_encoding_video_profile_get_type
    gvalueSet_ :: Ptr GValue -> Maybe EncodingVideoProfile -> IO ()
gvalueSet_ Ptr GValue
gv Maybe EncodingVideoProfile
P.Nothing = Ptr GValue -> Ptr EncodingVideoProfile -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr EncodingVideoProfile
forall a. Ptr a
FP.nullPtr :: FP.Ptr EncodingVideoProfile)
    gvalueSet_ Ptr GValue
gv (P.Just EncodingVideoProfile
obj) = EncodingVideoProfile
-> (Ptr EncodingVideoProfile -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr EncodingVideoProfile
obj (Ptr GValue -> Ptr EncodingVideoProfile -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe EncodingVideoProfile)
gvalueGet_ Ptr GValue
gv = do
        Ptr EncodingVideoProfile
ptr <- Ptr GValue -> IO (Ptr EncodingVideoProfile)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr EncodingVideoProfile)
        if Ptr EncodingVideoProfile
ptr Ptr EncodingVideoProfile -> Ptr EncodingVideoProfile -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr EncodingVideoProfile
forall a. Ptr a
FP.nullPtr
        then EncodingVideoProfile -> Maybe EncodingVideoProfile
forall a. a -> Maybe a
P.Just (EncodingVideoProfile -> Maybe EncodingVideoProfile)
-> IO EncodingVideoProfile -> IO (Maybe EncodingVideoProfile)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr EncodingVideoProfile -> EncodingVideoProfile)
-> Ptr EncodingVideoProfile -> IO EncodingVideoProfile
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr EncodingVideoProfile -> EncodingVideoProfile
EncodingVideoProfile Ptr EncodingVideoProfile
ptr
        else Maybe EncodingVideoProfile -> IO (Maybe EncodingVideoProfile)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe EncodingVideoProfile
forall a. Maybe a
P.Nothing
        
    

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

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

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveEncodingVideoProfileMethod t EncodingVideoProfile, O.OverloadedMethod info EncodingVideoProfile p, R.HasField t EncodingVideoProfile p) => R.HasField t EncodingVideoProfile p where
    getField = O.overloadedMethod @info

#endif

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

#endif

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

#if defined(ENABLE_OVERLOADING)
#endif

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

#endif

-- method EncodingVideoProfile::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstCaps" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "preset"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the preset(s) to use on the encoder, can be %NULL"
--                 , 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 #GstCaps used to restrict the input to the encoder, can be\nNULL. See gst_encoding_profile_get_restriction() for more details."
--                 , 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 this stream must be used. 0 means any number of\n times (including never)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GstPbutils" , name = "EncodingVideoProfile" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_encoding_video_profile_new" gst_encoding_video_profile_new :: 
    Ptr Gst.Caps.Caps ->                    -- format : TInterface (Name {namespace = "Gst", name = "Caps"})
    CString ->                              -- preset : TBasicType TUTF8
    Ptr Gst.Caps.Caps ->                    -- restriction : TInterface (Name {namespace = "Gst", name = "Caps"})
    Word32 ->                               -- presence : TBasicType TUInt
    IO (Ptr EncodingVideoProfile)

-- | Creates a new t'GI.GstPbutils.Objects.EncodingVideoProfile.EncodingVideoProfile'
-- 
-- All provided allocatable arguments will be internally copied, so can be
-- safely freed\/unreferenced after calling this method.
-- 
-- If you wish to control the pass number (in case of multi-pass scenarios),
-- please refer to the 'GI.GstPbutils.Objects.EncodingVideoProfile.encodingVideoProfileSetPass' documentation.
-- 
-- If you wish to use\/force a constant framerate please refer to the
-- 'GI.GstPbutils.Objects.EncodingVideoProfile.encodingVideoProfileSetVariableframerate' documentation.
encodingVideoProfileNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Caps.Caps
    -- ^ /@format@/: the t'GI.Gst.Structs.Caps.Caps'
    -> Maybe (T.Text)
    -- ^ /@preset@/: the preset(s) to use on the encoder, can be 'P.Nothing'
    -> Maybe (Gst.Caps.Caps)
    -- ^ /@restriction@/: the t'GI.Gst.Structs.Caps.Caps' used to restrict the input to the encoder, can be
    -- NULL. See 'GI.GstPbutils.Objects.EncodingProfile.encodingProfileGetRestriction' for more details.
    -> Word32
    -- ^ /@presence@/: the number of time this stream must be used. 0 means any number of
    --  times (including never)
    -> m EncodingVideoProfile
    -- ^ __Returns:__ the newly created t'GI.GstPbutils.Objects.EncodingVideoProfile.EncodingVideoProfile'.
encodingVideoProfileNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Caps
-> Maybe Text -> Maybe Caps -> Word32 -> m EncodingVideoProfile
encodingVideoProfileNew Caps
format Maybe Text
preset Maybe Caps
restriction Word32
presence = IO EncodingVideoProfile -> m EncodingVideoProfile
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO EncodingVideoProfile -> m EncodingVideoProfile)
-> IO EncodingVideoProfile -> m EncodingVideoProfile
forall a b. (a -> b) -> a -> b
$ do
    Ptr Caps
format' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
format
    Ptr CChar
maybePreset <- case Maybe Text
preset of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jPreset -> do
            Ptr CChar
jPreset' <- Text -> IO (Ptr CChar)
textToCString Text
jPreset
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jPreset'
    Ptr 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, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
jRestriction
            Ptr Caps -> IO (Ptr Caps)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Caps
jRestriction'
    Ptr EncodingVideoProfile
result <- Ptr Caps
-> Ptr CChar -> Ptr Caps -> Word32 -> IO (Ptr EncodingVideoProfile)
gst_encoding_video_profile_new Ptr Caps
format' Ptr CChar
maybePreset Ptr Caps
maybeRestriction Word32
presence
    Text -> Ptr EncodingVideoProfile -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"encodingVideoProfileNew" Ptr EncodingVideoProfile
result
    EncodingVideoProfile
result' <- ((ManagedPtr EncodingVideoProfile -> EncodingVideoProfile)
-> Ptr EncodingVideoProfile -> IO EncodingVideoProfile
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr EncodingVideoProfile -> EncodingVideoProfile
EncodingVideoProfile) Ptr EncodingVideoProfile
result
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
format
    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
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybePreset
    EncodingVideoProfile -> IO EncodingVideoProfile
forall (m :: * -> *) a. Monad m => a -> m a
return EncodingVideoProfile
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method EncodingVideoProfile::get_pass
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "prof"
--           , argType =
--               TInterface
--                 Name { namespace = "GstPbutils" , name = "EncodingVideoProfile" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstEncodingVideoProfile"
--                 , 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_video_profile_get_pass" gst_encoding_video_profile_get_pass :: 
    Ptr EncodingVideoProfile ->             -- prof : TInterface (Name {namespace = "GstPbutils", name = "EncodingVideoProfile"})
    IO Word32

-- | Get the pass number if this is part of a multi-pass profile.
encodingVideoProfileGetPass ::
    (B.CallStack.HasCallStack, MonadIO m, IsEncodingVideoProfile a) =>
    a
    -- ^ /@prof@/: a t'GI.GstPbutils.Objects.EncodingVideoProfile.EncodingVideoProfile'
    -> m Word32
    -- ^ __Returns:__ The pass number. Starts at 1 for multi-pass. 0 if this is
    -- not a multi-pass profile
encodingVideoProfileGetPass :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEncodingVideoProfile a) =>
a -> m Word32
encodingVideoProfileGetPass a
prof = 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 EncodingVideoProfile
prof' <- a -> IO (Ptr EncodingVideoProfile)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
prof
    Word32
result <- Ptr EncodingVideoProfile -> IO Word32
gst_encoding_video_profile_get_pass Ptr EncodingVideoProfile
prof'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
prof
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data EncodingVideoProfileGetPassMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsEncodingVideoProfile a) => O.OverloadedMethod EncodingVideoProfileGetPassMethodInfo a signature where
    overloadedMethod = encodingVideoProfileGetPass

instance O.OverloadedMethodInfo EncodingVideoProfileGetPassMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GstPbutils.Objects.EncodingVideoProfile.encodingVideoProfileGetPass",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gstpbutils-1.0.23/docs/GI-GstPbutils-Objects-EncodingVideoProfile.html#v:encodingVideoProfileGetPass"
        }


#endif

-- method EncodingVideoProfile::get_variableframerate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "prof"
--           , argType =
--               TInterface
--                 Name { namespace = "GstPbutils" , name = "EncodingVideoProfile" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstEncodingVideoProfile"
--                 , 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_video_profile_get_variableframerate" gst_encoding_video_profile_get_variableframerate :: 
    Ptr EncodingVideoProfile ->             -- prof : TInterface (Name {namespace = "GstPbutils", name = "EncodingVideoProfile"})
    IO CInt

-- | > *NOTE*: Fixed framerate won\'t be enforced when @/encodebin:avoid-reencoding/@
-- > is set.
encodingVideoProfileGetVariableframerate ::
    (B.CallStack.HasCallStack, MonadIO m, IsEncodingVideoProfile a) =>
    a
    -- ^ /@prof@/: a t'GI.GstPbutils.Objects.EncodingVideoProfile.EncodingVideoProfile'
    -> m Bool
    -- ^ __Returns:__ Whether non-constant video framerate is allowed for encoding.
encodingVideoProfileGetVariableframerate :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEncodingVideoProfile a) =>
a -> m Bool
encodingVideoProfileGetVariableframerate a
prof = 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 EncodingVideoProfile
prof' <- a -> IO (Ptr EncodingVideoProfile)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
prof
    CInt
result <- Ptr EncodingVideoProfile -> IO CInt
gst_encoding_video_profile_get_variableframerate Ptr EncodingVideoProfile
prof'
    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
prof
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data EncodingVideoProfileGetVariableframerateMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsEncodingVideoProfile a) => O.OverloadedMethod EncodingVideoProfileGetVariableframerateMethodInfo a signature where
    overloadedMethod = encodingVideoProfileGetVariableframerate

instance O.OverloadedMethodInfo EncodingVideoProfileGetVariableframerateMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GstPbutils.Objects.EncodingVideoProfile.encodingVideoProfileGetVariableframerate",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gstpbutils-1.0.23/docs/GI-GstPbutils-Objects-EncodingVideoProfile.html#v:encodingVideoProfileGetVariableframerate"
        }


#endif

-- method EncodingVideoProfile::set_pass
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "prof"
--           , argType =
--               TInterface
--                 Name { namespace = "GstPbutils" , name = "EncodingVideoProfile" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstEncodingVideoProfile"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "pass"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the pass number for 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_video_profile_set_pass" gst_encoding_video_profile_set_pass :: 
    Ptr EncodingVideoProfile ->             -- prof : TInterface (Name {namespace = "GstPbutils", name = "EncodingVideoProfile"})
    Word32 ->                               -- pass : TBasicType TUInt
    IO ()

-- | Sets the pass number of this video profile. The first pass profile should have
-- this value set to 1. If this video profile isn\'t part of a multi-pass profile,
-- you may set it to 0 (the default value).
encodingVideoProfileSetPass ::
    (B.CallStack.HasCallStack, MonadIO m, IsEncodingVideoProfile a) =>
    a
    -- ^ /@prof@/: a t'GI.GstPbutils.Objects.EncodingVideoProfile.EncodingVideoProfile'
    -> Word32
    -- ^ /@pass@/: the pass number for this profile
    -> m ()
encodingVideoProfileSetPass :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEncodingVideoProfile a) =>
a -> Word32 -> m ()
encodingVideoProfileSetPass a
prof Word32
pass = 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 EncodingVideoProfile
prof' <- a -> IO (Ptr EncodingVideoProfile)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
prof
    Ptr EncodingVideoProfile -> Word32 -> IO ()
gst_encoding_video_profile_set_pass Ptr EncodingVideoProfile
prof' Word32
pass
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
prof
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EncodingVideoProfileSetPassMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m, IsEncodingVideoProfile a) => O.OverloadedMethod EncodingVideoProfileSetPassMethodInfo a signature where
    overloadedMethod = encodingVideoProfileSetPass

instance O.OverloadedMethodInfo EncodingVideoProfileSetPassMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GstPbutils.Objects.EncodingVideoProfile.encodingVideoProfileSetPass",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gstpbutils-1.0.23/docs/GI-GstPbutils-Objects-EncodingVideoProfile.html#v:encodingVideoProfileSetPass"
        }


#endif

-- method EncodingVideoProfile::set_variableframerate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "prof"
--           , argType =
--               TInterface
--                 Name { namespace = "GstPbutils" , name = "EncodingVideoProfile" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstEncodingVideoProfile"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "variableframerate"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a boolean" , 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_video_profile_set_variableframerate" gst_encoding_video_profile_set_variableframerate :: 
    Ptr EncodingVideoProfile ->             -- prof : TInterface (Name {namespace = "GstPbutils", name = "EncodingVideoProfile"})
    CInt ->                                 -- variableframerate : TBasicType TBoolean
    IO ()

-- | If set to 'P.True', then the incoming stream will be allowed to have non-constant
-- framerate. If set to 'P.False' (default value), then the incoming stream will
-- be normalized by dropping\/duplicating frames in order to produce a
-- constance framerate.
encodingVideoProfileSetVariableframerate ::
    (B.CallStack.HasCallStack, MonadIO m, IsEncodingVideoProfile a) =>
    a
    -- ^ /@prof@/: a t'GI.GstPbutils.Objects.EncodingVideoProfile.EncodingVideoProfile'
    -> Bool
    -- ^ /@variableframerate@/: a boolean
    -> m ()
encodingVideoProfileSetVariableframerate :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEncodingVideoProfile a) =>
a -> Bool -> m ()
encodingVideoProfileSetVariableframerate a
prof Bool
variableframerate = 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 EncodingVideoProfile
prof' <- a -> IO (Ptr EncodingVideoProfile)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
prof
    let variableframerate' :: CInt
variableframerate' = (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
variableframerate
    Ptr EncodingVideoProfile -> CInt -> IO ()
gst_encoding_video_profile_set_variableframerate Ptr EncodingVideoProfile
prof' CInt
variableframerate'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
prof
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EncodingVideoProfileSetVariableframerateMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsEncodingVideoProfile a) => O.OverloadedMethod EncodingVideoProfileSetVariableframerateMethodInfo a signature where
    overloadedMethod = encodingVideoProfileSetVariableframerate

instance O.OverloadedMethodInfo EncodingVideoProfileSetVariableframerateMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GstPbutils.Objects.EncodingVideoProfile.encodingVideoProfileSetVariableframerate",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gstpbutils-1.0.23/docs/GI-GstPbutils-Objects-EncodingVideoProfile.html#v:encodingVideoProfileSetVariableframerate"
        }


#endif