{-# 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 audio streams.

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

module GI.GstPbutils.Objects.EncodingAudioProfile
    ( 

-- * Exported types
    EncodingAudioProfile(..)                ,
    IsEncodingAudioProfile                  ,
    toEncodingAudioProfile                  ,
    noEncodingAudioProfile                  ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveEncodingAudioProfileMethod       ,
#endif


-- ** new #method:new#

    encodingAudioProfileNew                 ,




    ) where

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

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

import 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 EncodingAudioProfile = EncodingAudioProfile (ManagedPtr EncodingAudioProfile)
    deriving (EncodingAudioProfile -> EncodingAudioProfile -> Bool
(EncodingAudioProfile -> EncodingAudioProfile -> Bool)
-> (EncodingAudioProfile -> EncodingAudioProfile -> Bool)
-> Eq EncodingAudioProfile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EncodingAudioProfile -> EncodingAudioProfile -> Bool
$c/= :: EncodingAudioProfile -> EncodingAudioProfile -> Bool
== :: EncodingAudioProfile -> EncodingAudioProfile -> Bool
$c== :: EncodingAudioProfile -> EncodingAudioProfile -> Bool
Eq)
foreign import ccall "gst_encoding_audio_profile_get_type"
    c_gst_encoding_audio_profile_get_type :: IO GType

instance GObject EncodingAudioProfile where
    gobjectType :: IO GType
gobjectType = IO GType
c_gst_encoding_audio_profile_get_type
    

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

-- | Type class for types which can be safely cast to `EncodingAudioProfile`, for instance with `toEncodingAudioProfile`.
class (GObject o, O.IsDescendantOf EncodingAudioProfile o) => IsEncodingAudioProfile o
instance (GObject o, O.IsDescendantOf EncodingAudioProfile o) => IsEncodingAudioProfile o

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

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

-- | A convenience alias for `Nothing` :: `Maybe` `EncodingAudioProfile`.
noEncodingAudioProfile :: Maybe EncodingAudioProfile
noEncodingAudioProfile :: Maybe EncodingAudioProfile
noEncodingAudioProfile = Maybe EncodingAudioProfile
forall a. Maybe a
Nothing

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

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

#endif

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

#if defined(ENABLE_OVERLOADING)
#endif

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

#endif

-- method EncodingAudioProfile::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 = "EncodingAudioProfile" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_encoding_audio_profile_new" gst_encoding_audio_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 EncodingAudioProfile)

-- | Creates a new t'GI.GstPbutils.Objects.EncodingAudioProfile.EncodingAudioProfile'
-- 
-- All provided allocatable arguments will be internally copied, so can be
-- safely freed\/unreferenced after calling this method.
encodingAudioProfileNew ::
    (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 EncodingAudioProfile
    -- ^ __Returns:__ the newly created t'GI.GstPbutils.Objects.EncodingAudioProfile.EncodingAudioProfile'.
encodingAudioProfileNew :: Caps
-> Maybe Text -> Maybe Caps -> Word32 -> m EncodingAudioProfile
encodingAudioProfileNew format :: Caps
format preset :: Maybe Text
preset restriction :: Maybe Caps
restriction presence :: Word32
presence = IO EncodingAudioProfile -> m EncodingAudioProfile
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO EncodingAudioProfile -> m EncodingAudioProfile)
-> IO EncodingAudioProfile -> m EncodingAudioProfile
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
        Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just jPreset :: 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
        Nothing -> Ptr Caps -> IO (Ptr Caps)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Caps
forall a. Ptr a
nullPtr
        Just jRestriction :: 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 EncodingAudioProfile
result <- Ptr Caps
-> Ptr CChar -> Ptr Caps -> Word32 -> IO (Ptr EncodingAudioProfile)
gst_encoding_audio_profile_new Ptr Caps
format' Ptr CChar
maybePreset Ptr Caps
maybeRestriction Word32
presence
    Text -> Ptr EncodingAudioProfile -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "encodingAudioProfileNew" Ptr EncodingAudioProfile
result
    EncodingAudioProfile
result' <- ((ManagedPtr EncodingAudioProfile -> EncodingAudioProfile)
-> Ptr EncodingAudioProfile -> IO EncodingAudioProfile
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr EncodingAudioProfile -> EncodingAudioProfile
EncodingAudioProfile) Ptr EncodingAudioProfile
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
    EncodingAudioProfile -> IO EncodingAudioProfile
forall (m :: * -> *) a. Monad m => a -> m a
return EncodingAudioProfile
result'

#if defined(ENABLE_OVERLOADING)
#endif