{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- This interface is implemented by elements that are able to do XMP serialization. Examples for
-- such elements are @/jifmux/@ and @/qtmux/@.
-- 
-- Applications can use this interface to configure which XMP schemas should be used when serializing
-- tags into XMP. Schemas are represented by their names, a full list of the supported schemas can be
-- obtained from 'GI.GstTag.Functions.tagXmpListSchemas'. By default, all schemas are used.

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

module GI.GstTag.Interfaces.TagXmpWriter
    ( 

-- * Exported types
    TagXmpWriter(..)                        ,
    noTagXmpWriter                          ,
    IsTagXmpWriter                          ,
    toTagXmpWriter                          ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveTagXmpWriterMethod               ,
#endif


-- ** addAllSchemas #method:addAllSchemas#

#if defined(ENABLE_OVERLOADING)
    TagXmpWriterAddAllSchemasMethodInfo     ,
#endif
    tagXmpWriterAddAllSchemas               ,


-- ** addSchema #method:addSchema#

#if defined(ENABLE_OVERLOADING)
    TagXmpWriterAddSchemaMethodInfo         ,
#endif
    tagXmpWriterAddSchema                   ,


-- ** hasSchema #method:hasSchema#

#if defined(ENABLE_OVERLOADING)
    TagXmpWriterHasSchemaMethodInfo         ,
#endif
    tagXmpWriterHasSchema                   ,


-- ** removeAllSchemas #method:removeAllSchemas#

#if defined(ENABLE_OVERLOADING)
    TagXmpWriterRemoveAllSchemasMethodInfo  ,
#endif
    tagXmpWriterRemoveAllSchemas            ,


-- ** removeSchema #method:removeSchema#

#if defined(ENABLE_OVERLOADING)
    TagXmpWriterRemoveSchemaMethodInfo      ,
#endif
    tagXmpWriterRemoveSchema                ,


-- ** tagListToXmpBuffer #method:tagListToXmpBuffer#

#if defined(ENABLE_OVERLOADING)
    TagXmpWriterTagListToXmpBufferMethodInfo,
#endif
    tagXmpWriterTagListToXmpBuffer          ,




    ) 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.Objects.Element as Gst.Element
import qualified GI.Gst.Objects.Object as Gst.Object
import qualified GI.Gst.Structs.Buffer as Gst.Buffer
import qualified GI.Gst.Structs.TagList as Gst.TagList

-- interface TagXmpWriter 
-- | Memory-managed wrapper type.
newtype TagXmpWriter = TagXmpWriter (ManagedPtr TagXmpWriter)
    deriving (TagXmpWriter -> TagXmpWriter -> Bool
(TagXmpWriter -> TagXmpWriter -> Bool)
-> (TagXmpWriter -> TagXmpWriter -> Bool) -> Eq TagXmpWriter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TagXmpWriter -> TagXmpWriter -> Bool
$c/= :: TagXmpWriter -> TagXmpWriter -> Bool
== :: TagXmpWriter -> TagXmpWriter -> Bool
$c== :: TagXmpWriter -> TagXmpWriter -> Bool
Eq)
-- | A convenience alias for `Nothing` :: `Maybe` `TagXmpWriter`.
noTagXmpWriter :: Maybe TagXmpWriter
noTagXmpWriter :: Maybe TagXmpWriter
noTagXmpWriter = Maybe TagXmpWriter
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList TagXmpWriter = TagXmpWriterSignalList
type TagXmpWriterSignalList = ('[ '("deepNotify", Gst.Object.ObjectDeepNotifySignalInfo), '("noMorePads", Gst.Element.ElementNoMorePadsSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("padAdded", Gst.Element.ElementPadAddedSignalInfo), '("padRemoved", Gst.Element.ElementPadRemovedSignalInfo)] :: [(Symbol, *)])

#endif

foreign import ccall "gst_tag_xmp_writer_get_type"
    c_gst_tag_xmp_writer_get_type :: IO GType

instance GObject TagXmpWriter where
    gobjectType :: IO GType
gobjectType = IO GType
c_gst_tag_xmp_writer_get_type
    

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

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

instance O.HasParentTypes TagXmpWriter
type instance O.ParentTypes TagXmpWriter = '[Gst.Element.Element, Gst.Object.Object, GObject.Object.Object]

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

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList TagXmpWriter
type instance O.AttributeList TagXmpWriter = TagXmpWriterAttributeList
type TagXmpWriterAttributeList = ('[ '("name", Gst.Object.ObjectNamePropertyInfo), '("parent", Gst.Object.ObjectParentPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveTagXmpWriterMethod (t :: Symbol) (o :: *) :: * where
    ResolveTagXmpWriterMethod "abortState" o = Gst.Element.ElementAbortStateMethodInfo
    ResolveTagXmpWriterMethod "addAllSchemas" o = TagXmpWriterAddAllSchemasMethodInfo
    ResolveTagXmpWriterMethod "addControlBinding" o = Gst.Object.ObjectAddControlBindingMethodInfo
    ResolveTagXmpWriterMethod "addPad" o = Gst.Element.ElementAddPadMethodInfo
    ResolveTagXmpWriterMethod "addPropertyDeepNotifyWatch" o = Gst.Element.ElementAddPropertyDeepNotifyWatchMethodInfo
    ResolveTagXmpWriterMethod "addPropertyNotifyWatch" o = Gst.Element.ElementAddPropertyNotifyWatchMethodInfo
    ResolveTagXmpWriterMethod "addSchema" o = TagXmpWriterAddSchemaMethodInfo
    ResolveTagXmpWriterMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveTagXmpWriterMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveTagXmpWriterMethod "callAsync" o = Gst.Element.ElementCallAsyncMethodInfo
    ResolveTagXmpWriterMethod "changeState" o = Gst.Element.ElementChangeStateMethodInfo
    ResolveTagXmpWriterMethod "continueState" o = Gst.Element.ElementContinueStateMethodInfo
    ResolveTagXmpWriterMethod "createAllPads" o = Gst.Element.ElementCreateAllPadsMethodInfo
    ResolveTagXmpWriterMethod "defaultError" o = Gst.Object.ObjectDefaultErrorMethodInfo
    ResolveTagXmpWriterMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveTagXmpWriterMethod "foreachPad" o = Gst.Element.ElementForeachPadMethodInfo
    ResolveTagXmpWriterMethod "foreachSinkPad" o = Gst.Element.ElementForeachSinkPadMethodInfo
    ResolveTagXmpWriterMethod "foreachSrcPad" o = Gst.Element.ElementForeachSrcPadMethodInfo
    ResolveTagXmpWriterMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveTagXmpWriterMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveTagXmpWriterMethod "hasActiveControlBindings" o = Gst.Object.ObjectHasActiveControlBindingsMethodInfo
    ResolveTagXmpWriterMethod "hasAncestor" o = Gst.Object.ObjectHasAncestorMethodInfo
    ResolveTagXmpWriterMethod "hasAsAncestor" o = Gst.Object.ObjectHasAsAncestorMethodInfo
    ResolveTagXmpWriterMethod "hasAsParent" o = Gst.Object.ObjectHasAsParentMethodInfo
    ResolveTagXmpWriterMethod "hasSchema" o = TagXmpWriterHasSchemaMethodInfo
    ResolveTagXmpWriterMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveTagXmpWriterMethod "isLockedState" o = Gst.Element.ElementIsLockedStateMethodInfo
    ResolveTagXmpWriterMethod "iteratePads" o = Gst.Element.ElementIteratePadsMethodInfo
    ResolveTagXmpWriterMethod "iterateSinkPads" o = Gst.Element.ElementIterateSinkPadsMethodInfo
    ResolveTagXmpWriterMethod "iterateSrcPads" o = Gst.Element.ElementIterateSrcPadsMethodInfo
    ResolveTagXmpWriterMethod "link" o = Gst.Element.ElementLinkMethodInfo
    ResolveTagXmpWriterMethod "linkFiltered" o = Gst.Element.ElementLinkFilteredMethodInfo
    ResolveTagXmpWriterMethod "linkPads" o = Gst.Element.ElementLinkPadsMethodInfo
    ResolveTagXmpWriterMethod "linkPadsFiltered" o = Gst.Element.ElementLinkPadsFilteredMethodInfo
    ResolveTagXmpWriterMethod "linkPadsFull" o = Gst.Element.ElementLinkPadsFullMethodInfo
    ResolveTagXmpWriterMethod "lostState" o = Gst.Element.ElementLostStateMethodInfo
    ResolveTagXmpWriterMethod "messageFull" o = Gst.Element.ElementMessageFullMethodInfo
    ResolveTagXmpWriterMethod "messageFullWithDetails" o = Gst.Element.ElementMessageFullWithDetailsMethodInfo
    ResolveTagXmpWriterMethod "noMorePads" o = Gst.Element.ElementNoMorePadsMethodInfo
    ResolveTagXmpWriterMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveTagXmpWriterMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveTagXmpWriterMethod "postMessage" o = Gst.Element.ElementPostMessageMethodInfo
    ResolveTagXmpWriterMethod "provideClock" o = Gst.Element.ElementProvideClockMethodInfo
    ResolveTagXmpWriterMethod "query" o = Gst.Element.ElementQueryMethodInfo
    ResolveTagXmpWriterMethod "queryConvert" o = Gst.Element.ElementQueryConvertMethodInfo
    ResolveTagXmpWriterMethod "queryDuration" o = Gst.Element.ElementQueryDurationMethodInfo
    ResolveTagXmpWriterMethod "queryPosition" o = Gst.Element.ElementQueryPositionMethodInfo
    ResolveTagXmpWriterMethod "ref" o = Gst.Object.ObjectRefMethodInfo
    ResolveTagXmpWriterMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveTagXmpWriterMethod "releaseRequestPad" o = Gst.Element.ElementReleaseRequestPadMethodInfo
    ResolveTagXmpWriterMethod "removeAllSchemas" o = TagXmpWriterRemoveAllSchemasMethodInfo
    ResolveTagXmpWriterMethod "removeControlBinding" o = Gst.Object.ObjectRemoveControlBindingMethodInfo
    ResolveTagXmpWriterMethod "removePad" o = Gst.Element.ElementRemovePadMethodInfo
    ResolveTagXmpWriterMethod "removePropertyNotifyWatch" o = Gst.Element.ElementRemovePropertyNotifyWatchMethodInfo
    ResolveTagXmpWriterMethod "removeSchema" o = TagXmpWriterRemoveSchemaMethodInfo
    ResolveTagXmpWriterMethod "requestPad" o = Gst.Element.ElementRequestPadMethodInfo
    ResolveTagXmpWriterMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveTagXmpWriterMethod "seek" o = Gst.Element.ElementSeekMethodInfo
    ResolveTagXmpWriterMethod "seekSimple" o = Gst.Element.ElementSeekSimpleMethodInfo
    ResolveTagXmpWriterMethod "sendEvent" o = Gst.Element.ElementSendEventMethodInfo
    ResolveTagXmpWriterMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveTagXmpWriterMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveTagXmpWriterMethod "suggestNextSync" o = Gst.Object.ObjectSuggestNextSyncMethodInfo
    ResolveTagXmpWriterMethod "syncStateWithParent" o = Gst.Element.ElementSyncStateWithParentMethodInfo
    ResolveTagXmpWriterMethod "syncValues" o = Gst.Object.ObjectSyncValuesMethodInfo
    ResolveTagXmpWriterMethod "tagListToXmpBuffer" o = TagXmpWriterTagListToXmpBufferMethodInfo
    ResolveTagXmpWriterMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveTagXmpWriterMethod "unlink" o = Gst.Element.ElementUnlinkMethodInfo
    ResolveTagXmpWriterMethod "unlinkPads" o = Gst.Element.ElementUnlinkPadsMethodInfo
    ResolveTagXmpWriterMethod "unparent" o = Gst.Object.ObjectUnparentMethodInfo
    ResolveTagXmpWriterMethod "unref" o = Gst.Object.ObjectUnrefMethodInfo
    ResolveTagXmpWriterMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveTagXmpWriterMethod "getBaseTime" o = Gst.Element.ElementGetBaseTimeMethodInfo
    ResolveTagXmpWriterMethod "getBus" o = Gst.Element.ElementGetBusMethodInfo
    ResolveTagXmpWriterMethod "getClock" o = Gst.Element.ElementGetClockMethodInfo
    ResolveTagXmpWriterMethod "getCompatiblePad" o = Gst.Element.ElementGetCompatiblePadMethodInfo
    ResolveTagXmpWriterMethod "getCompatiblePadTemplate" o = Gst.Element.ElementGetCompatiblePadTemplateMethodInfo
    ResolveTagXmpWriterMethod "getContext" o = Gst.Element.ElementGetContextMethodInfo
    ResolveTagXmpWriterMethod "getContextUnlocked" o = Gst.Element.ElementGetContextUnlockedMethodInfo
    ResolveTagXmpWriterMethod "getContexts" o = Gst.Element.ElementGetContextsMethodInfo
    ResolveTagXmpWriterMethod "getControlBinding" o = Gst.Object.ObjectGetControlBindingMethodInfo
    ResolveTagXmpWriterMethod "getControlRate" o = Gst.Object.ObjectGetControlRateMethodInfo
    ResolveTagXmpWriterMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveTagXmpWriterMethod "getFactory" o = Gst.Element.ElementGetFactoryMethodInfo
    ResolveTagXmpWriterMethod "getGValueArray" o = Gst.Object.ObjectGetGValueArrayMethodInfo
    ResolveTagXmpWriterMethod "getMetadata" o = Gst.Element.ElementGetMetadataMethodInfo
    ResolveTagXmpWriterMethod "getName" o = Gst.Object.ObjectGetNameMethodInfo
    ResolveTagXmpWriterMethod "getPadTemplate" o = Gst.Element.ElementGetPadTemplateMethodInfo
    ResolveTagXmpWriterMethod "getPadTemplateList" o = Gst.Element.ElementGetPadTemplateListMethodInfo
    ResolveTagXmpWriterMethod "getParent" o = Gst.Object.ObjectGetParentMethodInfo
    ResolveTagXmpWriterMethod "getPathString" o = Gst.Object.ObjectGetPathStringMethodInfo
    ResolveTagXmpWriterMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveTagXmpWriterMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveTagXmpWriterMethod "getRequestPad" o = Gst.Element.ElementGetRequestPadMethodInfo
    ResolveTagXmpWriterMethod "getStartTime" o = Gst.Element.ElementGetStartTimeMethodInfo
    ResolveTagXmpWriterMethod "getState" o = Gst.Element.ElementGetStateMethodInfo
    ResolveTagXmpWriterMethod "getStaticPad" o = Gst.Element.ElementGetStaticPadMethodInfo
    ResolveTagXmpWriterMethod "getValue" o = Gst.Object.ObjectGetValueMethodInfo
    ResolveTagXmpWriterMethod "setBaseTime" o = Gst.Element.ElementSetBaseTimeMethodInfo
    ResolveTagXmpWriterMethod "setBus" o = Gst.Element.ElementSetBusMethodInfo
    ResolveTagXmpWriterMethod "setClock" o = Gst.Element.ElementSetClockMethodInfo
    ResolveTagXmpWriterMethod "setContext" o = Gst.Element.ElementSetContextMethodInfo
    ResolveTagXmpWriterMethod "setControlBindingDisabled" o = Gst.Object.ObjectSetControlBindingDisabledMethodInfo
    ResolveTagXmpWriterMethod "setControlBindingsDisabled" o = Gst.Object.ObjectSetControlBindingsDisabledMethodInfo
    ResolveTagXmpWriterMethod "setControlRate" o = Gst.Object.ObjectSetControlRateMethodInfo
    ResolveTagXmpWriterMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveTagXmpWriterMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveTagXmpWriterMethod "setLockedState" o = Gst.Element.ElementSetLockedStateMethodInfo
    ResolveTagXmpWriterMethod "setName" o = Gst.Object.ObjectSetNameMethodInfo
    ResolveTagXmpWriterMethod "setParent" o = Gst.Object.ObjectSetParentMethodInfo
    ResolveTagXmpWriterMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveTagXmpWriterMethod "setStartTime" o = Gst.Element.ElementSetStartTimeMethodInfo
    ResolveTagXmpWriterMethod "setState" o = Gst.Element.ElementSetStateMethodInfo
    ResolveTagXmpWriterMethod l o = O.MethodResolutionFailed l o

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

#endif

-- method TagXmpWriter::add_all_schemas
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "config"
--           , argType =
--               TInterface Name { namespace = "GstTag" , name = "TagXmpWriter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstTagXmpWriter" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_tag_xmp_writer_add_all_schemas" gst_tag_xmp_writer_add_all_schemas :: 
    Ptr TagXmpWriter ->                     -- config : TInterface (Name {namespace = "GstTag", name = "TagXmpWriter"})
    IO ()

-- | Adds all available XMP schemas to the configuration. Meaning that
-- all will be used.
tagXmpWriterAddAllSchemas ::
    (B.CallStack.HasCallStack, MonadIO m, IsTagXmpWriter a) =>
    a
    -- ^ /@config@/: a t'GI.GstTag.Interfaces.TagXmpWriter.TagXmpWriter'
    -> m ()
tagXmpWriterAddAllSchemas :: a -> m ()
tagXmpWriterAddAllSchemas config :: a
config = 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 TagXmpWriter
config' <- a -> IO (Ptr TagXmpWriter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
config
    Ptr TagXmpWriter -> IO ()
gst_tag_xmp_writer_add_all_schemas Ptr TagXmpWriter
config'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
config
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TagXmpWriterAddAllSchemasMethodInfo
instance (signature ~ (m ()), MonadIO m, IsTagXmpWriter a) => O.MethodInfo TagXmpWriterAddAllSchemasMethodInfo a signature where
    overloadedMethod = tagXmpWriterAddAllSchemas

#endif

-- method TagXmpWriter::add_schema
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "config"
--           , argType =
--               TInterface Name { namespace = "GstTag" , name = "TagXmpWriter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstTagXmpWriter" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "schema"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the schema to be added"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_tag_xmp_writer_add_schema" gst_tag_xmp_writer_add_schema :: 
    Ptr TagXmpWriter ->                     -- config : TInterface (Name {namespace = "GstTag", name = "TagXmpWriter"})
    CString ->                              -- schema : TBasicType TUTF8
    IO ()

-- | Adds /@schema@/ to the list schemas
tagXmpWriterAddSchema ::
    (B.CallStack.HasCallStack, MonadIO m, IsTagXmpWriter a) =>
    a
    -- ^ /@config@/: a t'GI.GstTag.Interfaces.TagXmpWriter.TagXmpWriter'
    -> T.Text
    -- ^ /@schema@/: the schema to be added
    -> m ()
tagXmpWriterAddSchema :: a -> Text -> m ()
tagXmpWriterAddSchema config :: a
config schema :: Text
schema = 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 TagXmpWriter
config' <- a -> IO (Ptr TagXmpWriter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
config
    CString
schema' <- Text -> IO CString
textToCString Text
schema
    Ptr TagXmpWriter -> CString -> IO ()
gst_tag_xmp_writer_add_schema Ptr TagXmpWriter
config' CString
schema'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
config
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
schema'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TagXmpWriterAddSchemaMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsTagXmpWriter a) => O.MethodInfo TagXmpWriterAddSchemaMethodInfo a signature where
    overloadedMethod = tagXmpWriterAddSchema

#endif

-- method TagXmpWriter::has_schema
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "config"
--           , argType =
--               TInterface Name { namespace = "GstTag" , name = "TagXmpWriter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstTagXmpWriter" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "schema"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the schema to test" , 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_tag_xmp_writer_has_schema" gst_tag_xmp_writer_has_schema :: 
    Ptr TagXmpWriter ->                     -- config : TInterface (Name {namespace = "GstTag", name = "TagXmpWriter"})
    CString ->                              -- schema : TBasicType TUTF8
    IO CInt

-- | Checks if /@schema@/ is going to be used
tagXmpWriterHasSchema ::
    (B.CallStack.HasCallStack, MonadIO m, IsTagXmpWriter a) =>
    a
    -- ^ /@config@/: a t'GI.GstTag.Interfaces.TagXmpWriter.TagXmpWriter'
    -> T.Text
    -- ^ /@schema@/: the schema to test
    -> m Bool
    -- ^ __Returns:__ 'P.True' if it is going to be used
tagXmpWriterHasSchema :: a -> Text -> m Bool
tagXmpWriterHasSchema config :: a
config schema :: Text
schema = 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 TagXmpWriter
config' <- a -> IO (Ptr TagXmpWriter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
config
    CString
schema' <- Text -> IO CString
textToCString Text
schema
    CInt
result <- Ptr TagXmpWriter -> CString -> IO CInt
gst_tag_xmp_writer_has_schema Ptr TagXmpWriter
config' CString
schema'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
config
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
schema'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data TagXmpWriterHasSchemaMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m, IsTagXmpWriter a) => O.MethodInfo TagXmpWriterHasSchemaMethodInfo a signature where
    overloadedMethod = tagXmpWriterHasSchema

#endif

-- method TagXmpWriter::remove_all_schemas
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "config"
--           , argType =
--               TInterface Name { namespace = "GstTag" , name = "TagXmpWriter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstTagXmpWriter" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_tag_xmp_writer_remove_all_schemas" gst_tag_xmp_writer_remove_all_schemas :: 
    Ptr TagXmpWriter ->                     -- config : TInterface (Name {namespace = "GstTag", name = "TagXmpWriter"})
    IO ()

-- | Removes all schemas from the list of schemas to use. Meaning that no
-- XMP will be generated.
tagXmpWriterRemoveAllSchemas ::
    (B.CallStack.HasCallStack, MonadIO m, IsTagXmpWriter a) =>
    a
    -- ^ /@config@/: a t'GI.GstTag.Interfaces.TagXmpWriter.TagXmpWriter'
    -> m ()
tagXmpWriterRemoveAllSchemas :: a -> m ()
tagXmpWriterRemoveAllSchemas config :: a
config = 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 TagXmpWriter
config' <- a -> IO (Ptr TagXmpWriter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
config
    Ptr TagXmpWriter -> IO ()
gst_tag_xmp_writer_remove_all_schemas Ptr TagXmpWriter
config'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
config
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TagXmpWriterRemoveAllSchemasMethodInfo
instance (signature ~ (m ()), MonadIO m, IsTagXmpWriter a) => O.MethodInfo TagXmpWriterRemoveAllSchemasMethodInfo a signature where
    overloadedMethod = tagXmpWriterRemoveAllSchemas

#endif

-- method TagXmpWriter::remove_schema
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "config"
--           , argType =
--               TInterface Name { namespace = "GstTag" , name = "TagXmpWriter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstTagXmpWriter" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "schema"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the schema to remove"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_tag_xmp_writer_remove_schema" gst_tag_xmp_writer_remove_schema :: 
    Ptr TagXmpWriter ->                     -- config : TInterface (Name {namespace = "GstTag", name = "TagXmpWriter"})
    CString ->                              -- schema : TBasicType TUTF8
    IO ()

-- | Removes a schema from the list of schemas to use. Nothing is done if
-- the schema wasn\'t in the list
tagXmpWriterRemoveSchema ::
    (B.CallStack.HasCallStack, MonadIO m, IsTagXmpWriter a) =>
    a
    -- ^ /@config@/: a t'GI.GstTag.Interfaces.TagXmpWriter.TagXmpWriter'
    -> T.Text
    -- ^ /@schema@/: the schema to remove
    -> m ()
tagXmpWriterRemoveSchema :: a -> Text -> m ()
tagXmpWriterRemoveSchema config :: a
config schema :: Text
schema = 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 TagXmpWriter
config' <- a -> IO (Ptr TagXmpWriter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
config
    CString
schema' <- Text -> IO CString
textToCString Text
schema
    Ptr TagXmpWriter -> CString -> IO ()
gst_tag_xmp_writer_remove_schema Ptr TagXmpWriter
config' CString
schema'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
config
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
schema'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TagXmpWriterRemoveSchemaMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsTagXmpWriter a) => O.MethodInfo TagXmpWriterRemoveSchemaMethodInfo a signature where
    overloadedMethod = tagXmpWriterRemoveSchema

#endif

-- method TagXmpWriter::tag_list_to_xmp_buffer
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "config"
--           , argType =
--               TInterface Name { namespace = "GstTag" , name = "TagXmpWriter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "taglist"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "read_only"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Buffer" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_tag_xmp_writer_tag_list_to_xmp_buffer" gst_tag_xmp_writer_tag_list_to_xmp_buffer :: 
    Ptr TagXmpWriter ->                     -- config : TInterface (Name {namespace = "GstTag", name = "TagXmpWriter"})
    Ptr Gst.TagList.TagList ->              -- taglist : TInterface (Name {namespace = "Gst", name = "TagList"})
    CInt ->                                 -- read_only : TBasicType TBoolean
    IO (Ptr Gst.Buffer.Buffer)

-- | /No description available in the introspection data./
tagXmpWriterTagListToXmpBuffer ::
    (B.CallStack.HasCallStack, MonadIO m, IsTagXmpWriter a) =>
    a
    -> Gst.TagList.TagList
    -> Bool
    -> m Gst.Buffer.Buffer
tagXmpWriterTagListToXmpBuffer :: a -> TagList -> Bool -> m Buffer
tagXmpWriterTagListToXmpBuffer config :: a
config taglist :: TagList
taglist readOnly :: Bool
readOnly = IO Buffer -> m Buffer
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Buffer -> m Buffer) -> IO Buffer -> m Buffer
forall a b. (a -> b) -> a -> b
$ do
    Ptr TagXmpWriter
config' <- a -> IO (Ptr TagXmpWriter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
config
    Ptr TagList
taglist' <- TagList -> IO (Ptr TagList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TagList
taglist
    let readOnly' :: CInt
readOnly' = (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
readOnly
    Ptr Buffer
result <- Ptr TagXmpWriter -> Ptr TagList -> CInt -> IO (Ptr Buffer)
gst_tag_xmp_writer_tag_list_to_xmp_buffer Ptr TagXmpWriter
config' Ptr TagList
taglist' CInt
readOnly'
    Text -> Ptr Buffer -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "tagXmpWriterTagListToXmpBuffer" Ptr Buffer
result
    Buffer
result' <- ((ManagedPtr Buffer -> Buffer) -> Ptr Buffer -> IO Buffer
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Buffer -> Buffer
Gst.Buffer.Buffer) Ptr Buffer
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
config
    TagList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TagList
taglist
    Buffer -> IO Buffer
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer
result'

#if defined(ENABLE_OVERLOADING)
data TagXmpWriterTagListToXmpBufferMethodInfo
instance (signature ~ (Gst.TagList.TagList -> Bool -> m Gst.Buffer.Buffer), MonadIO m, IsTagXmpWriter a) => O.MethodInfo TagXmpWriterTagListToXmpBufferMethodInfo a signature where
    overloadedMethod = tagXmpWriterTagListToXmpBuffer

#endif