{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Collection of t'GI.GstPbutils.Objects.EncodingProfile.EncodingProfile' for a specific target or use-case.
-- 
-- When being stored\/loaded, targets come from a specific category, like
-- 'GI.GstPbutils.Constants.ENCODING_CATEGORY_DEVICE'.

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

module GI.GstPbutils.Objects.EncodingTarget
    ( 

-- * Exported types
    EncodingTarget(..)                      ,
    IsEncodingTarget                        ,
    toEncodingTarget                        ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [addProfile]("GI.GstPbutils.Objects.EncodingTarget#g:method:addProfile"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [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"), [save]("GI.GstPbutils.Objects.EncodingTarget#g:method:save"), [saveToFile]("GI.GstPbutils.Objects.EncodingTarget#g:method:saveToFile"), [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
-- [getCategory]("GI.GstPbutils.Objects.EncodingTarget#g:method:getCategory"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDescription]("GI.GstPbutils.Objects.EncodingTarget#g:method:getDescription"), [getName]("GI.GstPbutils.Objects.EncodingTarget#g:method:getName"), [getPath]("GI.GstPbutils.Objects.EncodingTarget#g:method:getPath"), [getProfile]("GI.GstPbutils.Objects.EncodingTarget#g:method:getProfile"), [getProfiles]("GI.GstPbutils.Objects.EncodingTarget#g:method:getProfiles"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveEncodingTargetMethod             ,
#endif

-- ** addProfile #method:addProfile#

#if defined(ENABLE_OVERLOADING)
    EncodingTargetAddProfileMethodInfo      ,
#endif
    encodingTargetAddProfile                ,


-- ** getCategory #method:getCategory#

#if defined(ENABLE_OVERLOADING)
    EncodingTargetGetCategoryMethodInfo     ,
#endif
    encodingTargetGetCategory               ,


-- ** getDescription #method:getDescription#

#if defined(ENABLE_OVERLOADING)
    EncodingTargetGetDescriptionMethodInfo  ,
#endif
    encodingTargetGetDescription            ,


-- ** getName #method:getName#

#if defined(ENABLE_OVERLOADING)
    EncodingTargetGetNameMethodInfo         ,
#endif
    encodingTargetGetName                   ,


-- ** getPath #method:getPath#

#if defined(ENABLE_OVERLOADING)
    EncodingTargetGetPathMethodInfo         ,
#endif
    encodingTargetGetPath                   ,


-- ** getProfile #method:getProfile#

#if defined(ENABLE_OVERLOADING)
    EncodingTargetGetProfileMethodInfo      ,
#endif
    encodingTargetGetProfile                ,


-- ** getProfiles #method:getProfiles#

#if defined(ENABLE_OVERLOADING)
    EncodingTargetGetProfilesMethodInfo     ,
#endif
    encodingTargetGetProfiles               ,


-- ** load #method:load#

    encodingTargetLoad                      ,


-- ** loadFromFile #method:loadFromFile#

    encodingTargetLoadFromFile              ,


-- ** new #method:new#

    encodingTargetNew                       ,


-- ** save #method:save#

#if defined(ENABLE_OVERLOADING)
    EncodingTargetSaveMethodInfo            ,
#endif
    encodingTargetSave                      ,


-- ** saveToFile #method:saveToFile#

#if defined(ENABLE_OVERLOADING)
    EncodingTargetSaveToFileMethodInfo      ,
#endif
    encodingTargetSaveToFile                ,




    ) 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.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
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 {-# SOURCE #-} qualified GI.GstPbutils.Objects.EncodingProfile as GstPbutils.EncodingProfile

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

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

foreign import ccall "gst_encoding_target_get_type"
    c_gst_encoding_target_get_type :: IO B.Types.GType

instance B.Types.TypedObject EncodingTarget where
    glibType :: IO GType
glibType = IO GType
c_gst_encoding_target_get_type

instance B.Types.GObject EncodingTarget

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveEncodingTargetMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveEncodingTargetMethod "addProfile" o = EncodingTargetAddProfileMethodInfo
    ResolveEncodingTargetMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveEncodingTargetMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveEncodingTargetMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveEncodingTargetMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveEncodingTargetMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveEncodingTargetMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveEncodingTargetMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveEncodingTargetMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveEncodingTargetMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveEncodingTargetMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveEncodingTargetMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveEncodingTargetMethod "save" o = EncodingTargetSaveMethodInfo
    ResolveEncodingTargetMethod "saveToFile" o = EncodingTargetSaveToFileMethodInfo
    ResolveEncodingTargetMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveEncodingTargetMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveEncodingTargetMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveEncodingTargetMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveEncodingTargetMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveEncodingTargetMethod "getCategory" o = EncodingTargetGetCategoryMethodInfo
    ResolveEncodingTargetMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveEncodingTargetMethod "getDescription" o = EncodingTargetGetDescriptionMethodInfo
    ResolveEncodingTargetMethod "getName" o = EncodingTargetGetNameMethodInfo
    ResolveEncodingTargetMethod "getPath" o = EncodingTargetGetPathMethodInfo
    ResolveEncodingTargetMethod "getProfile" o = EncodingTargetGetProfileMethodInfo
    ResolveEncodingTargetMethod "getProfiles" o = EncodingTargetGetProfilesMethodInfo
    ResolveEncodingTargetMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveEncodingTargetMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveEncodingTargetMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveEncodingTargetMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveEncodingTargetMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveEncodingTargetMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList EncodingTarget
type instance O.AttributeList EncodingTarget = EncodingTargetAttributeList
type EncodingTargetAttributeList = ('[ ] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList EncodingTarget = EncodingTargetSignalList
type EncodingTargetSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])

#endif

-- method EncodingTarget::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "name"
--           , 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 = "category"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The name of the category to which this @target\nbelongs. For example: #GST_ENCODING_CATEGORY_DEVICE."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "description"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A description of #GstEncodingTarget in the\ncurrent locale."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "profiles"
--           , argType =
--               TGList
--                 (TInterface
--                    Name { namespace = "GstPbutils" , name = "EncodingProfile" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GList of\n#GstEncodingProfile."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GstPbutils" , name = "EncodingTarget" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_encoding_target_new" gst_encoding_target_new :: 
    CString ->                              -- name : TBasicType TUTF8
    CString ->                              -- category : TBasicType TUTF8
    CString ->                              -- description : TBasicType TUTF8
    Ptr (GList (Ptr GstPbutils.EncodingProfile.EncodingProfile)) -> -- profiles : TGList (TInterface (Name {namespace = "GstPbutils", name = "EncodingProfile"}))
    IO (Ptr EncodingTarget)

-- | Creates a new t'GI.GstPbutils.Objects.EncodingTarget.EncodingTarget'.
-- 
-- The name and category can only consist of lowercase ASCII letters for the
-- first character, followed by either lowercase ASCII letters, digits or
-- hyphens (\'-\').
-- 
-- The /@category@/ *should* be one of the existing
-- well-defined categories, like 'GI.GstPbutils.Constants.ENCODING_CATEGORY_DEVICE', but it
-- *can* be a application or user specific category if
-- needed.
encodingTargetNew ::
    (B.CallStack.HasCallStack, MonadIO m, GstPbutils.EncodingProfile.IsEncodingProfile a) =>
    T.Text
    -- ^ /@name@/: The name of the target.
    -> T.Text
    -- ^ /@category@/: The name of the category to which this /@target@/
    -- belongs. For example: 'GI.GstPbutils.Constants.ENCODING_CATEGORY_DEVICE'.
    -> T.Text
    -- ^ /@description@/: A description of t'GI.GstPbutils.Objects.EncodingTarget.EncodingTarget' in the
    -- current locale.
    -> [a]
    -- ^ /@profiles@/: A t'GI.GLib.Structs.List.List' of
    -- t'GI.GstPbutils.Objects.EncodingProfile.EncodingProfile'.
    -> m (Maybe EncodingTarget)
    -- ^ __Returns:__ The newly created t'GI.GstPbutils.Objects.EncodingTarget.EncodingTarget' or 'P.Nothing' if
    -- there was an error.
encodingTargetNew :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEncodingProfile a) =>
Text -> Text -> Text -> [a] -> m (Maybe EncodingTarget)
encodingTargetNew Text
name Text
category Text
description [a]
profiles = IO (Maybe EncodingTarget) -> m (Maybe EncodingTarget)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe EncodingTarget) -> m (Maybe EncodingTarget))
-> IO (Maybe EncodingTarget) -> m (Maybe EncodingTarget)
forall a b. (a -> b) -> a -> b
$ do
    CString
name' <- Text -> IO CString
textToCString Text
name
    CString
category' <- Text -> IO CString
textToCString Text
category
    CString
description' <- Text -> IO CString
textToCString Text
description
    [Ptr EncodingProfile]
profiles' <- (a -> IO (Ptr EncodingProfile)) -> [a] -> IO [Ptr EncodingProfile]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM a -> IO (Ptr EncodingProfile)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr [a]
profiles
    Ptr (GList (Ptr EncodingProfile))
profiles'' <- [Ptr EncodingProfile] -> IO (Ptr (GList (Ptr EncodingProfile)))
forall a. [Ptr a] -> IO (Ptr (GList (Ptr a)))
packGList [Ptr EncodingProfile]
profiles'
    Ptr EncodingTarget
result <- CString
-> CString
-> CString
-> Ptr (GList (Ptr EncodingProfile))
-> IO (Ptr EncodingTarget)
gst_encoding_target_new CString
name' CString
category' CString
description' Ptr (GList (Ptr EncodingProfile))
profiles''
    Maybe EncodingTarget
maybeResult <- Ptr EncodingTarget
-> (Ptr EncodingTarget -> IO EncodingTarget)
-> IO (Maybe EncodingTarget)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr EncodingTarget
result ((Ptr EncodingTarget -> IO EncodingTarget)
 -> IO (Maybe EncodingTarget))
-> (Ptr EncodingTarget -> IO EncodingTarget)
-> IO (Maybe EncodingTarget)
forall a b. (a -> b) -> a -> b
$ \Ptr EncodingTarget
result' -> do
        EncodingTarget
result'' <- ((ManagedPtr EncodingTarget -> EncodingTarget)
-> Ptr EncodingTarget -> IO EncodingTarget
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr EncodingTarget -> EncodingTarget
EncodingTarget) Ptr EncodingTarget
result'
        EncodingTarget -> IO EncodingTarget
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return EncodingTarget
result''
    (a -> IO ()) -> [a] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [a]
profiles
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
category'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
description'
    Ptr (GList (Ptr EncodingProfile)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr EncodingProfile))
profiles''
    Maybe EncodingTarget -> IO (Maybe EncodingTarget)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe EncodingTarget
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

-- method EncodingTarget::add_profile
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "target"
--           , argType =
--               TInterface
--                 Name { namespace = "GstPbutils" , name = "EncodingTarget" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstEncodingTarget to add a profile to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "profile"
--           , argType =
--               TInterface
--                 Name { namespace = "GstPbutils" , name = "EncodingProfile" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstEncodingProfile to add"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_encoding_target_add_profile" gst_encoding_target_add_profile :: 
    Ptr EncodingTarget ->                   -- target : TInterface (Name {namespace = "GstPbutils", name = "EncodingTarget"})
    Ptr GstPbutils.EncodingProfile.EncodingProfile -> -- profile : TInterface (Name {namespace = "GstPbutils", name = "EncodingProfile"})
    IO CInt

-- | Adds the given /@profile@/ to the /@target@/. Each added profile must have
-- a unique name within the profile.
-- 
-- The /@target@/ will steal a reference to the /@profile@/. If you wish to use
-- the profile after calling this method, you should increase its reference
-- count.
encodingTargetAddProfile ::
    (B.CallStack.HasCallStack, MonadIO m, IsEncodingTarget a, GstPbutils.EncodingProfile.IsEncodingProfile b) =>
    a
    -- ^ /@target@/: the t'GI.GstPbutils.Objects.EncodingTarget.EncodingTarget' to add a profile to
    -> b
    -- ^ /@profile@/: the t'GI.GstPbutils.Objects.EncodingProfile.EncodingProfile' to add
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the profile was added, else 'P.False'.
encodingTargetAddProfile :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsEncodingTarget a,
 IsEncodingProfile b) =>
a -> b -> m Bool
encodingTargetAddProfile a
target b
profile = IO Bool -> m Bool
forall a. IO a -> m a
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 EncodingTarget
target' <- a -> IO (Ptr EncodingTarget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
target
    Ptr EncodingProfile
profile' <- b -> IO (Ptr EncodingProfile)
forall a b. (HasCallStack, GObject a) => a -> IO (Ptr b)
B.ManagedPtr.disownObject b
profile
    CInt
result <- Ptr EncodingTarget -> Ptr EncodingProfile -> IO CInt
gst_encoding_target_add_profile Ptr EncodingTarget
target' 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
target
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
profile
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

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

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


#endif

-- method EncodingTarget::get_category
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "target"
--           , argType =
--               TInterface
--                 Name { namespace = "GstPbutils" , name = "EncodingTarget" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstEncodingTarget"
--                 , 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_target_get_category" gst_encoding_target_get_category :: 
    Ptr EncodingTarget ->                   -- target : TInterface (Name {namespace = "GstPbutils", name = "EncodingTarget"})
    IO CString

-- | /No description available in the introspection data./
encodingTargetGetCategory ::
    (B.CallStack.HasCallStack, MonadIO m, IsEncodingTarget a) =>
    a
    -- ^ /@target@/: a t'GI.GstPbutils.Objects.EncodingTarget.EncodingTarget'
    -> m T.Text
    -- ^ __Returns:__ The category of the /@target@/. For example:
    -- 'GI.GstPbutils.Constants.ENCODING_CATEGORY_DEVICE'.
encodingTargetGetCategory :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEncodingTarget a) =>
a -> m Text
encodingTargetGetCategory a
target = IO Text -> m Text
forall a. IO a -> m a
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 EncodingTarget
target' <- a -> IO (Ptr EncodingTarget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
target
    CString
result <- Ptr EncodingTarget -> IO CString
gst_encoding_target_get_category Ptr EncodingTarget
target'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"encodingTargetGetCategory" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
target
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data EncodingTargetGetCategoryMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsEncodingTarget a) => O.OverloadedMethod EncodingTargetGetCategoryMethodInfo a signature where
    overloadedMethod = encodingTargetGetCategory

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


#endif

-- method EncodingTarget::get_description
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "target"
--           , argType =
--               TInterface
--                 Name { namespace = "GstPbutils" , name = "EncodingTarget" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstEncodingTarget"
--                 , 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_target_get_description" gst_encoding_target_get_description :: 
    Ptr EncodingTarget ->                   -- target : TInterface (Name {namespace = "GstPbutils", name = "EncodingTarget"})
    IO CString

-- | /No description available in the introspection data./
encodingTargetGetDescription ::
    (B.CallStack.HasCallStack, MonadIO m, IsEncodingTarget a) =>
    a
    -- ^ /@target@/: a t'GI.GstPbutils.Objects.EncodingTarget.EncodingTarget'
    -> m T.Text
    -- ^ __Returns:__ The description of the /@target@/.
encodingTargetGetDescription :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEncodingTarget a) =>
a -> m Text
encodingTargetGetDescription a
target = IO Text -> m Text
forall a. IO a -> m a
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 EncodingTarget
target' <- a -> IO (Ptr EncodingTarget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
target
    CString
result <- Ptr EncodingTarget -> IO CString
gst_encoding_target_get_description Ptr EncodingTarget
target'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"encodingTargetGetDescription" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
target
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data EncodingTargetGetDescriptionMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsEncodingTarget a) => O.OverloadedMethod EncodingTargetGetDescriptionMethodInfo a signature where
    overloadedMethod = encodingTargetGetDescription

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


#endif

-- method EncodingTarget::get_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "target"
--           , argType =
--               TInterface
--                 Name { namespace = "GstPbutils" , name = "EncodingTarget" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstEncodingTarget"
--                 , 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_target_get_name" gst_encoding_target_get_name :: 
    Ptr EncodingTarget ->                   -- target : TInterface (Name {namespace = "GstPbutils", name = "EncodingTarget"})
    IO CString

-- | /No description available in the introspection data./
encodingTargetGetName ::
    (B.CallStack.HasCallStack, MonadIO m, IsEncodingTarget a) =>
    a
    -- ^ /@target@/: a t'GI.GstPbutils.Objects.EncodingTarget.EncodingTarget'
    -> m T.Text
    -- ^ __Returns:__ The name of the /@target@/.
encodingTargetGetName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEncodingTarget a) =>
a -> m Text
encodingTargetGetName a
target = IO Text -> m Text
forall a. IO a -> m a
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 EncodingTarget
target' <- a -> IO (Ptr EncodingTarget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
target
    CString
result <- Ptr EncodingTarget -> IO CString
gst_encoding_target_get_name Ptr EncodingTarget
target'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"encodingTargetGetName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
target
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data EncodingTargetGetNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsEncodingTarget a) => O.OverloadedMethod EncodingTargetGetNameMethodInfo a signature where
    overloadedMethod = encodingTargetGetName

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


#endif

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

foreign import ccall "gst_encoding_target_get_path" gst_encoding_target_get_path :: 
    Ptr EncodingTarget ->                   -- target : TInterface (Name {namespace = "GstPbutils", name = "EncodingTarget"})
    IO CString

-- | /No description available in the introspection data./
-- 
-- /Since: 1.18/
encodingTargetGetPath ::
    (B.CallStack.HasCallStack, MonadIO m, IsEncodingTarget a) =>
    a
    -- ^ /@target@/: a t'GI.GstPbutils.Objects.EncodingTarget.EncodingTarget'
    -> m (Maybe [Char])
    -- ^ __Returns:__ The path to the /@target@/ file.
encodingTargetGetPath :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEncodingTarget a) =>
a -> m (Maybe [Char])
encodingTargetGetPath a
target = IO (Maybe [Char]) -> m (Maybe [Char])
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe [Char]) -> m (Maybe [Char]))
-> IO (Maybe [Char]) -> m (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ do
    Ptr EncodingTarget
target' <- a -> IO (Ptr EncodingTarget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
target
    CString
result <- Ptr EncodingTarget -> IO CString
gst_encoding_target_get_path Ptr EncodingTarget
target'
    Maybe [Char]
maybeResult <- CString -> (CString -> IO [Char]) -> IO (Maybe [Char])
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO [Char]) -> IO (Maybe [Char]))
-> (CString -> IO [Char]) -> IO (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        [Char]
result'' <- HasCallStack => CString -> IO [Char]
CString -> IO [Char]
cstringToString CString
result'
        [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
target
    Maybe [Char] -> IO (Maybe [Char])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Char]
maybeResult

#if defined(ENABLE_OVERLOADING)
data EncodingTargetGetPathMethodInfo
instance (signature ~ (m (Maybe [Char])), MonadIO m, IsEncodingTarget a) => O.OverloadedMethod EncodingTargetGetPathMethodInfo a signature where
    overloadedMethod = encodingTargetGetPath

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


#endif

-- method EncodingTarget::get_profile
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "target"
--           , argType =
--               TInterface
--                 Name { namespace = "GstPbutils" , name = "EncodingTarget" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstEncodingTarget"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the profile to retrieve"
--                 , 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_target_get_profile" gst_encoding_target_get_profile :: 
    Ptr EncodingTarget ->                   -- target : TInterface (Name {namespace = "GstPbutils", name = "EncodingTarget"})
    CString ->                              -- name : TBasicType TUTF8
    IO (Ptr GstPbutils.EncodingProfile.EncodingProfile)

-- | /No description available in the introspection data./
encodingTargetGetProfile ::
    (B.CallStack.HasCallStack, MonadIO m, IsEncodingTarget a) =>
    a
    -- ^ /@target@/: a t'GI.GstPbutils.Objects.EncodingTarget.EncodingTarget'
    -> T.Text
    -- ^ /@name@/: the name of the profile to retrieve
    -> m (Maybe GstPbutils.EncodingProfile.EncodingProfile)
    -- ^ __Returns:__ The matching t'GI.GstPbutils.Objects.EncodingProfile.EncodingProfile', or 'P.Nothing'.
encodingTargetGetProfile :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEncodingTarget a) =>
a -> Text -> m (Maybe EncodingProfile)
encodingTargetGetProfile a
target Text
name = IO (Maybe EncodingProfile) -> m (Maybe EncodingProfile)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe EncodingProfile) -> m (Maybe EncodingProfile))
-> IO (Maybe EncodingProfile) -> m (Maybe EncodingProfile)
forall a b. (a -> b) -> a -> b
$ do
    Ptr EncodingTarget
target' <- a -> IO (Ptr EncodingTarget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
target
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr EncodingProfile
result <- Ptr EncodingTarget -> CString -> IO (Ptr EncodingProfile)
gst_encoding_target_get_profile Ptr EncodingTarget
target' CString
name'
    Maybe EncodingProfile
maybeResult <- Ptr EncodingProfile
-> (Ptr EncodingProfile -> IO EncodingProfile)
-> IO (Maybe EncodingProfile)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr EncodingProfile
result ((Ptr EncodingProfile -> IO EncodingProfile)
 -> IO (Maybe EncodingProfile))
-> (Ptr EncodingProfile -> IO EncodingProfile)
-> IO (Maybe EncodingProfile)
forall a b. (a -> b) -> a -> b
$ \Ptr EncodingProfile
result' -> do
        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
GstPbutils.EncodingProfile.EncodingProfile) Ptr EncodingProfile
result'
        EncodingProfile -> IO EncodingProfile
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return EncodingProfile
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
target
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Maybe EncodingProfile -> IO (Maybe EncodingProfile)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe EncodingProfile
maybeResult

#if defined(ENABLE_OVERLOADING)
data EncodingTargetGetProfileMethodInfo
instance (signature ~ (T.Text -> m (Maybe GstPbutils.EncodingProfile.EncodingProfile)), MonadIO m, IsEncodingTarget a) => O.OverloadedMethod EncodingTargetGetProfileMethodInfo a signature where
    overloadedMethod = encodingTargetGetProfile

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


#endif

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

foreign import ccall "gst_encoding_target_get_profiles" gst_encoding_target_get_profiles :: 
    Ptr EncodingTarget ->                   -- target : TInterface (Name {namespace = "GstPbutils", name = "EncodingTarget"})
    IO (Ptr (GList (Ptr GstPbutils.EncodingProfile.EncodingProfile)))

-- | /No description available in the introspection data./
encodingTargetGetProfiles ::
    (B.CallStack.HasCallStack, MonadIO m, IsEncodingTarget a) =>
    a
    -- ^ /@target@/: a t'GI.GstPbutils.Objects.EncodingTarget.EncodingTarget'
    -> m [GstPbutils.EncodingProfile.EncodingProfile]
    -- ^ __Returns:__ A list of
    -- t'GI.GstPbutils.Objects.EncodingProfile.EncodingProfile'(s) this /@target@/ handles.
encodingTargetGetProfiles :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEncodingTarget a) =>
a -> m [EncodingProfile]
encodingTargetGetProfiles a
target = IO [EncodingProfile] -> m [EncodingProfile]
forall a. IO a -> m a
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 EncodingTarget
target' <- a -> IO (Ptr EncodingTarget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
target
    Ptr (GList (Ptr EncodingProfile))
result <- Ptr EncodingTarget -> IO (Ptr (GList (Ptr EncodingProfile)))
gst_encoding_target_get_profiles Ptr EncodingTarget
target'
    [Ptr EncodingProfile]
result' <- Ptr (GList (Ptr EncodingProfile)) -> IO [Ptr EncodingProfile]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr EncodingProfile))
result
    [EncodingProfile]
result'' <- (Ptr EncodingProfile -> IO EncodingProfile)
-> [Ptr EncodingProfile] -> IO [EncodingProfile]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ManagedPtr EncodingProfile -> EncodingProfile)
-> Ptr EncodingProfile -> IO EncodingProfile
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr EncodingProfile -> EncodingProfile
GstPbutils.EncodingProfile.EncodingProfile) [Ptr EncodingProfile]
result'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
target
    [EncodingProfile] -> IO [EncodingProfile]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [EncodingProfile]
result''

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

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


#endif

-- method EncodingTarget::save
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "target"
--           , argType =
--               TInterface
--                 Name { namespace = "GstPbutils" , name = "EncodingTarget" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstEncodingTarget"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "gst_encoding_target_save" gst_encoding_target_save :: 
    Ptr EncodingTarget ->                   -- target : TInterface (Name {namespace = "GstPbutils", name = "EncodingTarget"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Saves the /@target@/ to a default user-local directory.
encodingTargetSave ::
    (B.CallStack.HasCallStack, MonadIO m, IsEncodingTarget a) =>
    a
    -- ^ /@target@/: a t'GI.GstPbutils.Objects.EncodingTarget.EncodingTarget'
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
encodingTargetSave :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEncodingTarget a) =>
a -> m ()
encodingTargetSave a
target = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr EncodingTarget
target' <- a -> IO (Ptr EncodingTarget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
target
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr EncodingTarget -> Ptr (Ptr GError) -> IO CInt
gst_encoding_target_save Ptr EncodingTarget
target'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
target
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data EncodingTargetSaveMethodInfo
instance (signature ~ (m ()), MonadIO m, IsEncodingTarget a) => O.OverloadedMethod EncodingTargetSaveMethodInfo a signature where
    overloadedMethod = encodingTargetSave

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


#endif

-- method EncodingTarget::save_to_file
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "target"
--           , argType =
--               TInterface
--                 Name { namespace = "GstPbutils" , name = "EncodingTarget" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstEncodingTarget"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "filepath"
--           , argType = TBasicType TFileName
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the location to store the @target at."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "gst_encoding_target_save_to_file" gst_encoding_target_save_to_file :: 
    Ptr EncodingTarget ->                   -- target : TInterface (Name {namespace = "GstPbutils", name = "EncodingTarget"})
    CString ->                              -- filepath : TBasicType TFileName
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Saves the /@target@/ to the provided file location.
encodingTargetSaveToFile ::
    (B.CallStack.HasCallStack, MonadIO m, IsEncodingTarget a) =>
    a
    -- ^ /@target@/: a t'GI.GstPbutils.Objects.EncodingTarget.EncodingTarget'
    -> [Char]
    -- ^ /@filepath@/: the location to store the /@target@/ at.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
encodingTargetSaveToFile :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEncodingTarget a) =>
a -> [Char] -> m ()
encodingTargetSaveToFile a
target [Char]
filepath = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr EncodingTarget
target' <- a -> IO (Ptr EncodingTarget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
target
    CString
filepath' <- [Char] -> IO CString
stringToCString [Char]
filepath
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr EncodingTarget -> CString -> Ptr (Ptr GError) -> IO CInt
gst_encoding_target_save_to_file Ptr EncodingTarget
target' CString
filepath'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
target
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
filepath'
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
filepath'
     )

#if defined(ENABLE_OVERLOADING)
data EncodingTargetSaveToFileMethodInfo
instance (signature ~ ([Char] -> m ()), MonadIO m, IsEncodingTarget a) => O.OverloadedMethod EncodingTargetSaveToFileMethodInfo a signature where
    overloadedMethod = encodingTargetSaveToFile

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


#endif

-- method EncodingTarget::load
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the name of the #GstEncodingTarget to load (automatically\nconverted to lower case internally as capital letters are not\nvalid for target names)."
--                 , 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 name of the target category, like\n#GST_ENCODING_CATEGORY_DEVICE. Can be %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GstPbutils" , name = "EncodingTarget" })
-- throws : True
-- Skip return : False

foreign import ccall "gst_encoding_target_load" gst_encoding_target_load :: 
    CString ->                              -- name : TBasicType TUTF8
    CString ->                              -- category : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr EncodingTarget)

-- | Searches for the t'GI.GstPbutils.Objects.EncodingTarget.EncodingTarget' with the given name, loads it
-- and returns it.
-- 
-- If the category name is specified only targets from that category will be
-- searched for.
encodingTargetLoad ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@name@/: the name of the t'GI.GstPbutils.Objects.EncodingTarget.EncodingTarget' to load (automatically
    -- converted to lower case internally as capital letters are not
    -- valid for target names).
    -> Maybe (T.Text)
    -- ^ /@category@/: the name of the target category, like
    -- 'GI.GstPbutils.Constants.ENCODING_CATEGORY_DEVICE'. Can be 'P.Nothing'
    -> m EncodingTarget
    -- ^ __Returns:__ The t'GI.GstPbutils.Objects.EncodingTarget.EncodingTarget' if available, else 'P.Nothing'. /(Can throw 'Data.GI.Base.GError.GError')/
encodingTargetLoad :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> Maybe Text -> m EncodingTarget
encodingTargetLoad Text
name Maybe Text
category = IO EncodingTarget -> m EncodingTarget
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO EncodingTarget -> m EncodingTarget)
-> IO EncodingTarget -> m EncodingTarget
forall a b. (a -> b) -> a -> b
$ do
    CString
name' <- Text -> IO CString
textToCString Text
name
    CString
maybeCategory <- case Maybe Text
category of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jCategory'
    IO EncodingTarget -> IO () -> IO EncodingTarget
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr EncodingTarget
result <- (Ptr (Ptr GError) -> IO (Ptr EncodingTarget))
-> IO (Ptr EncodingTarget)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr EncodingTarget))
 -> IO (Ptr EncodingTarget))
-> (Ptr (Ptr GError) -> IO (Ptr EncodingTarget))
-> IO (Ptr EncodingTarget)
forall a b. (a -> b) -> a -> b
$ CString -> CString -> Ptr (Ptr GError) -> IO (Ptr EncodingTarget)
gst_encoding_target_load CString
name' CString
maybeCategory
        Text -> Ptr EncodingTarget -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"encodingTargetLoad" Ptr EncodingTarget
result
        EncodingTarget
result' <- ((ManagedPtr EncodingTarget -> EncodingTarget)
-> Ptr EncodingTarget -> IO EncodingTarget
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr EncodingTarget -> EncodingTarget
EncodingTarget) Ptr EncodingTarget
result
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeCategory
        EncodingTarget -> IO EncodingTarget
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return EncodingTarget
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeCategory
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method EncodingTarget::load_from_file
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "filepath"
--           , argType = TBasicType TFileName
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The file location to load the #GstEncodingTarget from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GstPbutils" , name = "EncodingTarget" })
-- throws : True
-- Skip return : False

foreign import ccall "gst_encoding_target_load_from_file" gst_encoding_target_load_from_file :: 
    CString ->                              -- filepath : TBasicType TFileName
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr EncodingTarget)

-- | Opens the provided file and returns the contained t'GI.GstPbutils.Objects.EncodingTarget.EncodingTarget'.
encodingTargetLoadFromFile ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    [Char]
    -- ^ /@filepath@/: The file location to load the t'GI.GstPbutils.Objects.EncodingTarget.EncodingTarget' from
    -> m EncodingTarget
    -- ^ __Returns:__ The t'GI.GstPbutils.Objects.EncodingTarget.EncodingTarget' contained in the file, else
    -- 'P.Nothing' /(Can throw 'Data.GI.Base.GError.GError')/
encodingTargetLoadFromFile :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
[Char] -> m EncodingTarget
encodingTargetLoadFromFile [Char]
filepath = IO EncodingTarget -> m EncodingTarget
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO EncodingTarget -> m EncodingTarget)
-> IO EncodingTarget -> m EncodingTarget
forall a b. (a -> b) -> a -> b
$ do
    CString
filepath' <- [Char] -> IO CString
stringToCString [Char]
filepath
    IO EncodingTarget -> IO () -> IO EncodingTarget
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr EncodingTarget
result <- (Ptr (Ptr GError) -> IO (Ptr EncodingTarget))
-> IO (Ptr EncodingTarget)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr EncodingTarget))
 -> IO (Ptr EncodingTarget))
-> (Ptr (Ptr GError) -> IO (Ptr EncodingTarget))
-> IO (Ptr EncodingTarget)
forall a b. (a -> b) -> a -> b
$ CString -> Ptr (Ptr GError) -> IO (Ptr EncodingTarget)
gst_encoding_target_load_from_file CString
filepath'
        Text -> Ptr EncodingTarget -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"encodingTargetLoadFromFile" Ptr EncodingTarget
result
        EncodingTarget
result' <- ((ManagedPtr EncodingTarget -> EncodingTarget)
-> Ptr EncodingTarget -> IO EncodingTarget
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr EncodingTarget -> EncodingTarget
EncodingTarget) Ptr EncodingTarget
result
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
filepath'
        EncodingTarget -> IO EncodingTarget
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return EncodingTarget
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
filepath'
     )

#if defined(ENABLE_OVERLOADING)
#endif