{-# LANGUAGE ImplicitParams, RankNTypes, TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- GstElement is the abstract base class needed to construct an element that
-- can be used in a GStreamer pipeline. Please refer to the plugin writers
-- guide for more information on creating t'GI.Gst.Objects.Element.Element' subclasses.
-- 
-- The name of a t'GI.Gst.Objects.Element.Element' can be get with @/gst_element_get_name()/@ and set with
-- @/gst_element_set_name()/@.  For speed, @/GST_ELEMENT_NAME()/@ can be used in the
-- core when using the appropriate locking. Do not use this in plug-ins or
-- applications in order to retain ABI compatibility.
-- 
-- Elements can have pads (of the type t'GI.Gst.Objects.Pad.Pad').  These pads link to pads on
-- other elements.  t'GI.Gst.Structs.Buffer.Buffer' flow between these linked pads.
-- A t'GI.Gst.Objects.Element.Element' has a t'GI.GLib.Structs.List.List' of t'GI.Gst.Objects.Pad.Pad' structures for all their input (or sink)
-- and output (or source) pads.
-- Core and plug-in writers can add and remove pads with 'GI.Gst.Objects.Element.elementAddPad'
-- and 'GI.Gst.Objects.Element.elementRemovePad'.
-- 
-- An existing pad of an element can be retrieved by name with
-- 'GI.Gst.Objects.Element.elementGetStaticPad'. A new dynamic pad can be created using
-- 'GI.Gst.Objects.Element.elementRequestPad' with a t'GI.Gst.Objects.PadTemplate.PadTemplate'.
-- An iterator of all pads can be retrieved with 'GI.Gst.Objects.Element.elementIteratePads'.
-- 
-- Elements can be linked through their pads.
-- If the link is straightforward, use the 'GI.Gst.Objects.Element.elementLink'
-- convenience function to link two elements, or @/gst_element_link_many()/@
-- for more elements in a row.
-- Use 'GI.Gst.Objects.Element.elementLinkFiltered' to link two elements constrained by
-- a specified set of t'GI.Gst.Structs.Caps.Caps'.
-- For finer control, use 'GI.Gst.Objects.Element.elementLinkPads' and
-- 'GI.Gst.Objects.Element.elementLinkPadsFiltered' to specify the pads to link on
-- each element by name.
-- 
-- Each element has a state (see t'GI.Gst.Enums.State').  You can get and set the state
-- of an element with 'GI.Gst.Objects.Element.elementGetState' and 'GI.Gst.Objects.Element.elementSetState'.
-- Setting a state triggers a t'GI.Gst.Enums.StateChange'. To get a string representation
-- of a t'GI.Gst.Enums.State', use 'GI.Gst.Objects.Element.elementStateGetName'.
-- 
-- You can get and set a t'GI.Gst.Objects.Clock.Clock' on an element using 'GI.Gst.Objects.Element.elementGetClock'
-- and 'GI.Gst.Objects.Element.elementSetClock'.
-- Some elements can provide a clock for the pipeline if
-- the @/GST_ELEMENT_FLAG_PROVIDE_CLOCK/@ flag is set. With the
-- 'GI.Gst.Objects.Element.elementProvideClock' method one can retrieve the clock provided by
-- such an element.
-- Not all elements require a clock to operate correctly. If the
-- @/GST_ELEMENT_FLAG_REQUIRE_CLOCK/@() flag is set, a clock should be set on the
-- element with 'GI.Gst.Objects.Element.elementSetClock'.
-- 
-- Note that clock selection and distribution is normally handled by the
-- toplevel t'GI.Gst.Objects.Pipeline.Pipeline' so the clock functions are only to be used in very
-- specific situations.

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

module GI.Gst.Objects.Element
    ( 

-- * Exported types
    Element(..)                             ,
    IsElement                               ,
    toElement                               ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [abortState]("GI.Gst.Objects.Element#g:method:abortState"), [addControlBinding]("GI.Gst.Objects.Object#g:method:addControlBinding"), [addPad]("GI.Gst.Objects.Element#g:method:addPad"), [addPropertyDeepNotifyWatch]("GI.Gst.Objects.Element#g:method:addPropertyDeepNotifyWatch"), [addPropertyNotifyWatch]("GI.Gst.Objects.Element#g:method:addPropertyNotifyWatch"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [callAsync]("GI.Gst.Objects.Element#g:method:callAsync"), [changeState]("GI.Gst.Objects.Element#g:method:changeState"), [continueState]("GI.Gst.Objects.Element#g:method:continueState"), [createAllPads]("GI.Gst.Objects.Element#g:method:createAllPads"), [defaultError]("GI.Gst.Objects.Object#g:method:defaultError"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [foreachPad]("GI.Gst.Objects.Element#g:method:foreachPad"), [foreachSinkPad]("GI.Gst.Objects.Element#g:method:foreachSinkPad"), [foreachSrcPad]("GI.Gst.Objects.Element#g:method:foreachSrcPad"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [hasActiveControlBindings]("GI.Gst.Objects.Object#g:method:hasActiveControlBindings"), [hasAncestor]("GI.Gst.Objects.Object#g:method:hasAncestor"), [hasAsAncestor]("GI.Gst.Objects.Object#g:method:hasAsAncestor"), [hasAsParent]("GI.Gst.Objects.Object#g:method:hasAsParent"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [isLockedState]("GI.Gst.Objects.Element#g:method:isLockedState"), [iteratePads]("GI.Gst.Objects.Element#g:method:iteratePads"), [iterateSinkPads]("GI.Gst.Objects.Element#g:method:iterateSinkPads"), [iterateSrcPads]("GI.Gst.Objects.Element#g:method:iterateSrcPads"), [link]("GI.Gst.Objects.Element#g:method:link"), [linkFiltered]("GI.Gst.Objects.Element#g:method:linkFiltered"), [linkPads]("GI.Gst.Objects.Element#g:method:linkPads"), [linkPadsFiltered]("GI.Gst.Objects.Element#g:method:linkPadsFiltered"), [linkPadsFull]("GI.Gst.Objects.Element#g:method:linkPadsFull"), [lostState]("GI.Gst.Objects.Element#g:method:lostState"), [messageFull]("GI.Gst.Objects.Element#g:method:messageFull"), [messageFullWithDetails]("GI.Gst.Objects.Element#g:method:messageFullWithDetails"), [noMorePads]("GI.Gst.Objects.Element#g:method:noMorePads"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [postMessage]("GI.Gst.Objects.Element#g:method:postMessage"), [provideClock]("GI.Gst.Objects.Element#g:method:provideClock"), [query]("GI.Gst.Objects.Element#g:method:query"), [queryConvert]("GI.Gst.Objects.Element#g:method:queryConvert"), [queryDuration]("GI.Gst.Objects.Element#g:method:queryDuration"), [queryPosition]("GI.Gst.Objects.Element#g:method:queryPosition"), [ref]("GI.Gst.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [releaseRequestPad]("GI.Gst.Objects.Element#g:method:releaseRequestPad"), [removeControlBinding]("GI.Gst.Objects.Object#g:method:removeControlBinding"), [removePad]("GI.Gst.Objects.Element#g:method:removePad"), [removePropertyNotifyWatch]("GI.Gst.Objects.Element#g:method:removePropertyNotifyWatch"), [requestPad]("GI.Gst.Objects.Element#g:method:requestPad"), [requestPadSimple]("GI.Gst.Objects.Element#g:method:requestPadSimple"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [seek]("GI.Gst.Objects.Element#g:method:seek"), [seekSimple]("GI.Gst.Objects.Element#g:method:seekSimple"), [sendEvent]("GI.Gst.Objects.Element#g:method:sendEvent"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [suggestNextSync]("GI.Gst.Objects.Object#g:method:suggestNextSync"), [syncStateWithParent]("GI.Gst.Objects.Element#g:method:syncStateWithParent"), [syncValues]("GI.Gst.Objects.Object#g:method:syncValues"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unlink]("GI.Gst.Objects.Element#g:method:unlink"), [unlinkPads]("GI.Gst.Objects.Element#g:method:unlinkPads"), [unparent]("GI.Gst.Objects.Object#g:method:unparent"), [unref]("GI.Gst.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getBaseTime]("GI.Gst.Objects.Element#g:method:getBaseTime"), [getBus]("GI.Gst.Objects.Element#g:method:getBus"), [getClock]("GI.Gst.Objects.Element#g:method:getClock"), [getCompatiblePad]("GI.Gst.Objects.Element#g:method:getCompatiblePad"), [getCompatiblePadTemplate]("GI.Gst.Objects.Element#g:method:getCompatiblePadTemplate"), [getContext]("GI.Gst.Objects.Element#g:method:getContext"), [getContextUnlocked]("GI.Gst.Objects.Element#g:method:getContextUnlocked"), [getContexts]("GI.Gst.Objects.Element#g:method:getContexts"), [getControlBinding]("GI.Gst.Objects.Object#g:method:getControlBinding"), [getControlRate]("GI.Gst.Objects.Object#g:method:getControlRate"), [getCurrentClockTime]("GI.Gst.Objects.Element#g:method:getCurrentClockTime"), [getCurrentRunningTime]("GI.Gst.Objects.Element#g:method:getCurrentRunningTime"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getFactory]("GI.Gst.Objects.Element#g:method:getFactory"), [getGValueArray]("GI.Gst.Objects.Object#g:method:getGValueArray"), [getMetadata]("GI.Gst.Objects.Element#g:method:getMetadata"), [getName]("GI.Gst.Objects.Object#g:method:getName"), [getPadTemplate]("GI.Gst.Objects.Element#g:method:getPadTemplate"), [getPadTemplateList]("GI.Gst.Objects.Element#g:method:getPadTemplateList"), [getParent]("GI.Gst.Objects.Object#g:method:getParent"), [getPathString]("GI.Gst.Objects.Object#g:method:getPathString"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getRequestPad]("GI.Gst.Objects.Element#g:method:getRequestPad"), [getStartTime]("GI.Gst.Objects.Element#g:method:getStartTime"), [getState]("GI.Gst.Objects.Element#g:method:getState"), [getStaticPad]("GI.Gst.Objects.Element#g:method:getStaticPad"), [getValue]("GI.Gst.Objects.Object#g:method:getValue").
-- 
-- ==== Setters
-- [setBaseTime]("GI.Gst.Objects.Element#g:method:setBaseTime"), [setBus]("GI.Gst.Objects.Element#g:method:setBus"), [setClock]("GI.Gst.Objects.Element#g:method:setClock"), [setContext]("GI.Gst.Objects.Element#g:method:setContext"), [setControlBindingDisabled]("GI.Gst.Objects.Object#g:method:setControlBindingDisabled"), [setControlBindingsDisabled]("GI.Gst.Objects.Object#g:method:setControlBindingsDisabled"), [setControlRate]("GI.Gst.Objects.Object#g:method:setControlRate"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setLockedState]("GI.Gst.Objects.Element#g:method:setLockedState"), [setName]("GI.Gst.Objects.Object#g:method:setName"), [setParent]("GI.Gst.Objects.Object#g:method:setParent"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setStartTime]("GI.Gst.Objects.Element#g:method:setStartTime"), [setState]("GI.Gst.Objects.Element#g:method:setState").

#if defined(ENABLE_OVERLOADING)
    ResolveElementMethod                    ,
#endif

-- ** abortState #method:abortState#

#if defined(ENABLE_OVERLOADING)
    ElementAbortStateMethodInfo             ,
#endif
    elementAbortState                       ,


-- ** addPad #method:addPad#

#if defined(ENABLE_OVERLOADING)
    ElementAddPadMethodInfo                 ,
#endif
    elementAddPad                           ,


-- ** addPropertyDeepNotifyWatch #method:addPropertyDeepNotifyWatch#

#if defined(ENABLE_OVERLOADING)
    ElementAddPropertyDeepNotifyWatchMethodInfo,
#endif
    elementAddPropertyDeepNotifyWatch       ,


-- ** addPropertyNotifyWatch #method:addPropertyNotifyWatch#

#if defined(ENABLE_OVERLOADING)
    ElementAddPropertyNotifyWatchMethodInfo ,
#endif
    elementAddPropertyNotifyWatch           ,


-- ** callAsync #method:callAsync#

#if defined(ENABLE_OVERLOADING)
    ElementCallAsyncMethodInfo              ,
#endif
    elementCallAsync                        ,


-- ** changeState #method:changeState#

#if defined(ENABLE_OVERLOADING)
    ElementChangeStateMethodInfo            ,
#endif
    elementChangeState                      ,


-- ** continueState #method:continueState#

#if defined(ENABLE_OVERLOADING)
    ElementContinueStateMethodInfo          ,
#endif
    elementContinueState                    ,


-- ** createAllPads #method:createAllPads#

#if defined(ENABLE_OVERLOADING)
    ElementCreateAllPadsMethodInfo          ,
#endif
    elementCreateAllPads                    ,


-- ** foreachPad #method:foreachPad#

#if defined(ENABLE_OVERLOADING)
    ElementForeachPadMethodInfo             ,
#endif
    elementForeachPad                       ,


-- ** foreachSinkPad #method:foreachSinkPad#

#if defined(ENABLE_OVERLOADING)
    ElementForeachSinkPadMethodInfo         ,
#endif
    elementForeachSinkPad                   ,


-- ** foreachSrcPad #method:foreachSrcPad#

#if defined(ENABLE_OVERLOADING)
    ElementForeachSrcPadMethodInfo          ,
#endif
    elementForeachSrcPad                    ,


-- ** getBaseTime #method:getBaseTime#

#if defined(ENABLE_OVERLOADING)
    ElementGetBaseTimeMethodInfo            ,
#endif
    elementGetBaseTime                      ,


-- ** getBus #method:getBus#

#if defined(ENABLE_OVERLOADING)
    ElementGetBusMethodInfo                 ,
#endif
    elementGetBus                           ,


-- ** getClock #method:getClock#

#if defined(ENABLE_OVERLOADING)
    ElementGetClockMethodInfo               ,
#endif
    elementGetClock                         ,


-- ** getCompatiblePad #method:getCompatiblePad#

#if defined(ENABLE_OVERLOADING)
    ElementGetCompatiblePadMethodInfo       ,
#endif
    elementGetCompatiblePad                 ,


-- ** getCompatiblePadTemplate #method:getCompatiblePadTemplate#

#if defined(ENABLE_OVERLOADING)
    ElementGetCompatiblePadTemplateMethodInfo,
#endif
    elementGetCompatiblePadTemplate         ,


-- ** getContext #method:getContext#

#if defined(ENABLE_OVERLOADING)
    ElementGetContextMethodInfo             ,
#endif
    elementGetContext                       ,


-- ** getContextUnlocked #method:getContextUnlocked#

#if defined(ENABLE_OVERLOADING)
    ElementGetContextUnlockedMethodInfo     ,
#endif
    elementGetContextUnlocked               ,


-- ** getContexts #method:getContexts#

#if defined(ENABLE_OVERLOADING)
    ElementGetContextsMethodInfo            ,
#endif
    elementGetContexts                      ,


-- ** getCurrentClockTime #method:getCurrentClockTime#

#if defined(ENABLE_OVERLOADING)
    ElementGetCurrentClockTimeMethodInfo    ,
#endif
    elementGetCurrentClockTime              ,


-- ** getCurrentRunningTime #method:getCurrentRunningTime#

#if defined(ENABLE_OVERLOADING)
    ElementGetCurrentRunningTimeMethodInfo  ,
#endif
    elementGetCurrentRunningTime            ,


-- ** getFactory #method:getFactory#

#if defined(ENABLE_OVERLOADING)
    ElementGetFactoryMethodInfo             ,
#endif
    elementGetFactory                       ,


-- ** getMetadata #method:getMetadata#

#if defined(ENABLE_OVERLOADING)
    ElementGetMetadataMethodInfo            ,
#endif
    elementGetMetadata                      ,


-- ** getPadTemplate #method:getPadTemplate#

#if defined(ENABLE_OVERLOADING)
    ElementGetPadTemplateMethodInfo         ,
#endif
    elementGetPadTemplate                   ,


-- ** getPadTemplateList #method:getPadTemplateList#

#if defined(ENABLE_OVERLOADING)
    ElementGetPadTemplateListMethodInfo     ,
#endif
    elementGetPadTemplateList               ,


-- ** getRequestPad #method:getRequestPad#

#if defined(ENABLE_OVERLOADING)
    ElementGetRequestPadMethodInfo          ,
#endif
    elementGetRequestPad                    ,


-- ** getStartTime #method:getStartTime#

#if defined(ENABLE_OVERLOADING)
    ElementGetStartTimeMethodInfo           ,
#endif
    elementGetStartTime                     ,


-- ** getState #method:getState#

#if defined(ENABLE_OVERLOADING)
    ElementGetStateMethodInfo               ,
#endif
    elementGetState                         ,


-- ** getStaticPad #method:getStaticPad#

#if defined(ENABLE_OVERLOADING)
    ElementGetStaticPadMethodInfo           ,
#endif
    elementGetStaticPad                     ,


-- ** isLockedState #method:isLockedState#

#if defined(ENABLE_OVERLOADING)
    ElementIsLockedStateMethodInfo          ,
#endif
    elementIsLockedState                    ,


-- ** iteratePads #method:iteratePads#

#if defined(ENABLE_OVERLOADING)
    ElementIteratePadsMethodInfo            ,
#endif
    elementIteratePads                      ,


-- ** iterateSinkPads #method:iterateSinkPads#

#if defined(ENABLE_OVERLOADING)
    ElementIterateSinkPadsMethodInfo        ,
#endif
    elementIterateSinkPads                  ,


-- ** iterateSrcPads #method:iterateSrcPads#

#if defined(ENABLE_OVERLOADING)
    ElementIterateSrcPadsMethodInfo         ,
#endif
    elementIterateSrcPads                   ,


-- ** link #method:link#

#if defined(ENABLE_OVERLOADING)
    ElementLinkMethodInfo                   ,
#endif
    elementLink                             ,


-- ** linkFiltered #method:linkFiltered#

#if defined(ENABLE_OVERLOADING)
    ElementLinkFilteredMethodInfo           ,
#endif
    elementLinkFiltered                     ,


-- ** linkPads #method:linkPads#

#if defined(ENABLE_OVERLOADING)
    ElementLinkPadsMethodInfo               ,
#endif
    elementLinkPads                         ,


-- ** linkPadsFiltered #method:linkPadsFiltered#

#if defined(ENABLE_OVERLOADING)
    ElementLinkPadsFilteredMethodInfo       ,
#endif
    elementLinkPadsFiltered                 ,


-- ** linkPadsFull #method:linkPadsFull#

#if defined(ENABLE_OVERLOADING)
    ElementLinkPadsFullMethodInfo           ,
#endif
    elementLinkPadsFull                     ,


-- ** lostState #method:lostState#

#if defined(ENABLE_OVERLOADING)
    ElementLostStateMethodInfo              ,
#endif
    elementLostState                        ,


-- ** makeFromUri #method:makeFromUri#

    elementMakeFromUri                      ,


-- ** messageFull #method:messageFull#

#if defined(ENABLE_OVERLOADING)
    ElementMessageFullMethodInfo            ,
#endif
    elementMessageFull                      ,


-- ** messageFullWithDetails #method:messageFullWithDetails#

#if defined(ENABLE_OVERLOADING)
    ElementMessageFullWithDetailsMethodInfo ,
#endif
    elementMessageFullWithDetails           ,


-- ** noMorePads #method:noMorePads#

#if defined(ENABLE_OVERLOADING)
    ElementNoMorePadsMethodInfo             ,
#endif
    elementNoMorePads                       ,


-- ** postMessage #method:postMessage#

#if defined(ENABLE_OVERLOADING)
    ElementPostMessageMethodInfo            ,
#endif
    elementPostMessage                      ,


-- ** provideClock #method:provideClock#

#if defined(ENABLE_OVERLOADING)
    ElementProvideClockMethodInfo           ,
#endif
    elementProvideClock                     ,


-- ** query #method:query#

#if defined(ENABLE_OVERLOADING)
    ElementQueryMethodInfo                  ,
#endif
    elementQuery                            ,


-- ** queryConvert #method:queryConvert#

#if defined(ENABLE_OVERLOADING)
    ElementQueryConvertMethodInfo           ,
#endif
    elementQueryConvert                     ,


-- ** queryDuration #method:queryDuration#

#if defined(ENABLE_OVERLOADING)
    ElementQueryDurationMethodInfo          ,
#endif
    elementQueryDuration                    ,


-- ** queryPosition #method:queryPosition#

#if defined(ENABLE_OVERLOADING)
    ElementQueryPositionMethodInfo          ,
#endif
    elementQueryPosition                    ,


-- ** register #method:register#

    elementRegister                         ,


-- ** releaseRequestPad #method:releaseRequestPad#

#if defined(ENABLE_OVERLOADING)
    ElementReleaseRequestPadMethodInfo      ,
#endif
    elementReleaseRequestPad                ,


-- ** removePad #method:removePad#

#if defined(ENABLE_OVERLOADING)
    ElementRemovePadMethodInfo              ,
#endif
    elementRemovePad                        ,


-- ** removePropertyNotifyWatch #method:removePropertyNotifyWatch#

#if defined(ENABLE_OVERLOADING)
    ElementRemovePropertyNotifyWatchMethodInfo,
#endif
    elementRemovePropertyNotifyWatch        ,


-- ** requestPad #method:requestPad#

#if defined(ENABLE_OVERLOADING)
    ElementRequestPadMethodInfo             ,
#endif
    elementRequestPad                       ,


-- ** requestPadSimple #method:requestPadSimple#

#if defined(ENABLE_OVERLOADING)
    ElementRequestPadSimpleMethodInfo       ,
#endif
    elementRequestPadSimple                 ,


-- ** seek #method:seek#

#if defined(ENABLE_OVERLOADING)
    ElementSeekMethodInfo                   ,
#endif
    elementSeek                             ,


-- ** seekSimple #method:seekSimple#

#if defined(ENABLE_OVERLOADING)
    ElementSeekSimpleMethodInfo             ,
#endif
    elementSeekSimple                       ,


-- ** sendEvent #method:sendEvent#

#if defined(ENABLE_OVERLOADING)
    ElementSendEventMethodInfo              ,
#endif
    elementSendEvent                        ,


-- ** setBaseTime #method:setBaseTime#

#if defined(ENABLE_OVERLOADING)
    ElementSetBaseTimeMethodInfo            ,
#endif
    elementSetBaseTime                      ,


-- ** setBus #method:setBus#

#if defined(ENABLE_OVERLOADING)
    ElementSetBusMethodInfo                 ,
#endif
    elementSetBus                           ,


-- ** setClock #method:setClock#

#if defined(ENABLE_OVERLOADING)
    ElementSetClockMethodInfo               ,
#endif
    elementSetClock                         ,


-- ** setContext #method:setContext#

#if defined(ENABLE_OVERLOADING)
    ElementSetContextMethodInfo             ,
#endif
    elementSetContext                       ,


-- ** setLockedState #method:setLockedState#

#if defined(ENABLE_OVERLOADING)
    ElementSetLockedStateMethodInfo         ,
#endif
    elementSetLockedState                   ,


-- ** setStartTime #method:setStartTime#

#if defined(ENABLE_OVERLOADING)
    ElementSetStartTimeMethodInfo           ,
#endif
    elementSetStartTime                     ,


-- ** setState #method:setState#

#if defined(ENABLE_OVERLOADING)
    ElementSetStateMethodInfo               ,
#endif
    elementSetState                         ,


-- ** stateChangeReturnGetName #method:stateChangeReturnGetName#

    elementStateChangeReturnGetName         ,


-- ** stateGetName #method:stateGetName#

    elementStateGetName                     ,


-- ** syncStateWithParent #method:syncStateWithParent#

#if defined(ENABLE_OVERLOADING)
    ElementSyncStateWithParentMethodInfo    ,
#endif
    elementSyncStateWithParent              ,


-- ** typeSetSkipDocumentation #method:typeSetSkipDocumentation#

    elementTypeSetSkipDocumentation         ,


-- ** unlink #method:unlink#

#if defined(ENABLE_OVERLOADING)
    ElementUnlinkMethodInfo                 ,
#endif
    elementUnlink                           ,


-- ** unlinkPads #method:unlinkPads#

#if defined(ENABLE_OVERLOADING)
    ElementUnlinkPadsMethodInfo             ,
#endif
    elementUnlinkPads                       ,




 -- * Signals


-- ** noMorePads #signal:noMorePads#

    ElementNoMorePadsCallback               ,
#if defined(ENABLE_OVERLOADING)
    ElementNoMorePadsSignalInfo             ,
#endif
    afterElementNoMorePads                  ,
    onElementNoMorePads                     ,


-- ** padAdded #signal:padAdded#

    ElementPadAddedCallback                 ,
#if defined(ENABLE_OVERLOADING)
    ElementPadAddedSignalInfo               ,
#endif
    afterElementPadAdded                    ,
    onElementPadAdded                       ,


-- ** padRemoved #signal:padRemoved#

    ElementPadRemovedCallback               ,
#if defined(ENABLE_OVERLOADING)
    ElementPadRemovedSignalInfo             ,
#endif
    afterElementPadRemoved                  ,
    onElementPadRemoved                     ,




    ) 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.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.GLib.Callbacks as GLib.Callbacks
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gst.Callbacks as Gst.Callbacks
import {-# SOURCE #-} qualified GI.Gst.Enums as Gst.Enums
import {-# SOURCE #-} qualified GI.Gst.Flags as Gst.Flags
import {-# SOURCE #-} qualified GI.Gst.Objects.Bus as Gst.Bus
import {-# SOURCE #-} qualified GI.Gst.Objects.Clock as Gst.Clock
import {-# SOURCE #-} qualified GI.Gst.Objects.ElementFactory as Gst.ElementFactory
import {-# SOURCE #-} qualified GI.Gst.Objects.Object as Gst.Object
import {-# SOURCE #-} qualified GI.Gst.Objects.Pad as Gst.Pad
import {-# SOURCE #-} qualified GI.Gst.Objects.PadTemplate as Gst.PadTemplate
import {-# SOURCE #-} qualified GI.Gst.Objects.Plugin as Gst.Plugin
import {-# SOURCE #-} qualified GI.Gst.Structs.Caps as Gst.Caps
import {-# SOURCE #-} qualified GI.Gst.Structs.Context as Gst.Context
import {-# SOURCE #-} qualified GI.Gst.Structs.Event as Gst.Event
import {-# SOURCE #-} qualified GI.Gst.Structs.Iterator as Gst.Iterator
import {-# SOURCE #-} qualified GI.Gst.Structs.Message as Gst.Message
import {-# SOURCE #-} qualified GI.Gst.Structs.Query as Gst.Query
import {-# SOURCE #-} qualified GI.Gst.Structs.Structure as Gst.Structure

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

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

foreign import ccall "gst_element_get_type"
    c_gst_element_get_type :: IO B.Types.GType

instance B.Types.TypedObject Element where
    glibType :: IO GType
glibType = IO GType
c_gst_element_get_type

instance B.Types.GObject Element

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

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

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

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

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

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

#endif

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

#endif

-- signal Element::no-more-pads
-- | This signals that the element will not generate more dynamic pads.
-- Note that this signal will usually be emitted from the context of
-- the streaming thread.
type ElementNoMorePadsCallback =
    IO ()

type C_ElementNoMorePadsCallback =
    Ptr Element ->                          -- object
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_ElementNoMorePadsCallback`.
foreign import ccall "wrapper"
    mk_ElementNoMorePadsCallback :: C_ElementNoMorePadsCallback -> IO (FunPtr C_ElementNoMorePadsCallback)

wrap_ElementNoMorePadsCallback :: 
    GObject a => (a -> ElementNoMorePadsCallback) ->
    C_ElementNoMorePadsCallback
wrap_ElementNoMorePadsCallback :: forall a. GObject a => (a -> IO ()) -> C_ElementNoMorePadsCallback
wrap_ElementNoMorePadsCallback a -> IO ()
gi'cb Ptr Element
gi'selfPtr Ptr ()
_ = do
    Ptr Element -> (Element -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Element
gi'selfPtr ((Element -> IO ()) -> IO ()) -> (Element -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Element
gi'self -> a -> IO ()
gi'cb (Element -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Element
gi'self) 


-- | Connect a signal handler for the [noMorePads](#signal:noMorePads) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' element #noMorePads callback
-- @
-- 
-- 
onElementNoMorePads :: (IsElement a, MonadIO m) => a -> ((?self :: a) => ElementNoMorePadsCallback) -> m SignalHandlerId
onElementNoMorePads :: forall a (m :: * -> *).
(IsElement a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onElementNoMorePads a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_ElementNoMorePadsCallback
wrapped' = (a -> IO ()) -> C_ElementNoMorePadsCallback
forall a. GObject a => (a -> IO ()) -> C_ElementNoMorePadsCallback
wrap_ElementNoMorePadsCallback a -> IO ()
wrapped
    FunPtr C_ElementNoMorePadsCallback
wrapped'' <- C_ElementNoMorePadsCallback
-> IO (FunPtr C_ElementNoMorePadsCallback)
mk_ElementNoMorePadsCallback C_ElementNoMorePadsCallback
wrapped'
    a
-> Text
-> FunPtr C_ElementNoMorePadsCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"no-more-pads" FunPtr C_ElementNoMorePadsCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [noMorePads](#signal:noMorePads) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' element #noMorePads callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterElementNoMorePads :: (IsElement a, MonadIO m) => a -> ((?self :: a) => ElementNoMorePadsCallback) -> m SignalHandlerId
afterElementNoMorePads :: forall a (m :: * -> *).
(IsElement a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterElementNoMorePads a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_ElementNoMorePadsCallback
wrapped' = (a -> IO ()) -> C_ElementNoMorePadsCallback
forall a. GObject a => (a -> IO ()) -> C_ElementNoMorePadsCallback
wrap_ElementNoMorePadsCallback a -> IO ()
wrapped
    FunPtr C_ElementNoMorePadsCallback
wrapped'' <- C_ElementNoMorePadsCallback
-> IO (FunPtr C_ElementNoMorePadsCallback)
mk_ElementNoMorePadsCallback C_ElementNoMorePadsCallback
wrapped'
    a
-> Text
-> FunPtr C_ElementNoMorePadsCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"no-more-pads" FunPtr C_ElementNoMorePadsCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ElementNoMorePadsSignalInfo
instance SignalInfo ElementNoMorePadsSignalInfo where
    type HaskellCallbackType ElementNoMorePadsSignalInfo = ElementNoMorePadsCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ElementNoMorePadsCallback cb
        cb'' <- mk_ElementNoMorePadsCallback cb'
        connectSignalFunPtr obj "no-more-pads" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element::no-more-pads"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#g:signal:noMorePads"})

#endif

-- signal Element::pad-added
-- | a new t'GI.Gst.Objects.Pad.Pad' has been added to the element. Note that this signal will
-- usually be emitted from the context of the streaming thread. Also keep in
-- mind that if you add new elements to the pipeline in the signal handler
-- you will need to set them to the desired target state with
-- 'GI.Gst.Objects.Element.elementSetState' or 'GI.Gst.Objects.Element.elementSyncStateWithParent'.
type ElementPadAddedCallback =
    Gst.Pad.Pad
    -- ^ /@newPad@/: the pad that has been added
    -> IO ()

type C_ElementPadAddedCallback =
    Ptr Element ->                          -- object
    Ptr Gst.Pad.Pad ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_ElementPadAddedCallback`.
foreign import ccall "wrapper"
    mk_ElementPadAddedCallback :: C_ElementPadAddedCallback -> IO (FunPtr C_ElementPadAddedCallback)

wrap_ElementPadAddedCallback :: 
    GObject a => (a -> ElementPadAddedCallback) ->
    C_ElementPadAddedCallback
wrap_ElementPadAddedCallback :: forall a.
GObject a =>
(a -> ElementPadAddedCallback) -> C_ElementPadAddedCallback
wrap_ElementPadAddedCallback a -> ElementPadAddedCallback
gi'cb Ptr Element
gi'selfPtr Ptr Pad
newPad Ptr ()
_ = do
    Pad
newPad' <- ((ManagedPtr Pad -> Pad) -> Ptr Pad -> IO Pad
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Pad -> Pad
Gst.Pad.Pad) Ptr Pad
newPad
    Ptr Element -> (Element -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Element
gi'selfPtr ((Element -> IO ()) -> IO ()) -> (Element -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Element
gi'self -> a -> ElementPadAddedCallback
gi'cb (Element -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Element
gi'self)  Pad
newPad'


-- | Connect a signal handler for the [padAdded](#signal:padAdded) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' element #padAdded callback
-- @
-- 
-- 
onElementPadAdded :: (IsElement a, MonadIO m) => a -> ((?self :: a) => ElementPadAddedCallback) -> m SignalHandlerId
onElementPadAdded :: forall a (m :: * -> *).
(IsElement a, MonadIO m) =>
a -> ((?self::a) => ElementPadAddedCallback) -> m SignalHandlerId
onElementPadAdded a
obj (?self::a) => ElementPadAddedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ElementPadAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ElementPadAddedCallback
ElementPadAddedCallback
cb
    let wrapped' :: C_ElementPadAddedCallback
wrapped' = (a -> ElementPadAddedCallback) -> C_ElementPadAddedCallback
forall a.
GObject a =>
(a -> ElementPadAddedCallback) -> C_ElementPadAddedCallback
wrap_ElementPadAddedCallback a -> ElementPadAddedCallback
wrapped
    FunPtr C_ElementPadAddedCallback
wrapped'' <- C_ElementPadAddedCallback -> IO (FunPtr C_ElementPadAddedCallback)
mk_ElementPadAddedCallback C_ElementPadAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_ElementPadAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"pad-added" FunPtr C_ElementPadAddedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [padAdded](#signal:padAdded) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' element #padAdded callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterElementPadAdded :: (IsElement a, MonadIO m) => a -> ((?self :: a) => ElementPadAddedCallback) -> m SignalHandlerId
afterElementPadAdded :: forall a (m :: * -> *).
(IsElement a, MonadIO m) =>
a -> ((?self::a) => ElementPadAddedCallback) -> m SignalHandlerId
afterElementPadAdded a
obj (?self::a) => ElementPadAddedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ElementPadAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ElementPadAddedCallback
ElementPadAddedCallback
cb
    let wrapped' :: C_ElementPadAddedCallback
wrapped' = (a -> ElementPadAddedCallback) -> C_ElementPadAddedCallback
forall a.
GObject a =>
(a -> ElementPadAddedCallback) -> C_ElementPadAddedCallback
wrap_ElementPadAddedCallback a -> ElementPadAddedCallback
wrapped
    FunPtr C_ElementPadAddedCallback
wrapped'' <- C_ElementPadAddedCallback -> IO (FunPtr C_ElementPadAddedCallback)
mk_ElementPadAddedCallback C_ElementPadAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_ElementPadAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"pad-added" FunPtr C_ElementPadAddedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ElementPadAddedSignalInfo
instance SignalInfo ElementPadAddedSignalInfo where
    type HaskellCallbackType ElementPadAddedSignalInfo = ElementPadAddedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ElementPadAddedCallback cb
        cb'' <- mk_ElementPadAddedCallback cb'
        connectSignalFunPtr obj "pad-added" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element::pad-added"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#g:signal:padAdded"})

#endif

-- signal Element::pad-removed
-- | a t'GI.Gst.Objects.Pad.Pad' has been removed from the element
type ElementPadRemovedCallback =
    Gst.Pad.Pad
    -- ^ /@oldPad@/: the pad that has been removed
    -> IO ()

type C_ElementPadRemovedCallback =
    Ptr Element ->                          -- object
    Ptr Gst.Pad.Pad ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_ElementPadRemovedCallback`.
foreign import ccall "wrapper"
    mk_ElementPadRemovedCallback :: C_ElementPadRemovedCallback -> IO (FunPtr C_ElementPadRemovedCallback)

wrap_ElementPadRemovedCallback :: 
    GObject a => (a -> ElementPadRemovedCallback) ->
    C_ElementPadRemovedCallback
wrap_ElementPadRemovedCallback :: forall a.
GObject a =>
(a -> ElementPadAddedCallback) -> C_ElementPadAddedCallback
wrap_ElementPadRemovedCallback a -> ElementPadAddedCallback
gi'cb Ptr Element
gi'selfPtr Ptr Pad
oldPad Ptr ()
_ = do
    Pad
oldPad' <- ((ManagedPtr Pad -> Pad) -> Ptr Pad -> IO Pad
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Pad -> Pad
Gst.Pad.Pad) Ptr Pad
oldPad
    Ptr Element -> (Element -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Element
gi'selfPtr ((Element -> IO ()) -> IO ()) -> (Element -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Element
gi'self -> a -> ElementPadAddedCallback
gi'cb (Element -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Element
gi'self)  Pad
oldPad'


-- | Connect a signal handler for the [padRemoved](#signal:padRemoved) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' element #padRemoved callback
-- @
-- 
-- 
onElementPadRemoved :: (IsElement a, MonadIO m) => a -> ((?self :: a) => ElementPadRemovedCallback) -> m SignalHandlerId
onElementPadRemoved :: forall a (m :: * -> *).
(IsElement a, MonadIO m) =>
a -> ((?self::a) => ElementPadAddedCallback) -> m SignalHandlerId
onElementPadRemoved a
obj (?self::a) => ElementPadAddedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ElementPadAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ElementPadAddedCallback
ElementPadAddedCallback
cb
    let wrapped' :: C_ElementPadAddedCallback
wrapped' = (a -> ElementPadAddedCallback) -> C_ElementPadAddedCallback
forall a.
GObject a =>
(a -> ElementPadAddedCallback) -> C_ElementPadAddedCallback
wrap_ElementPadRemovedCallback a -> ElementPadAddedCallback
wrapped
    FunPtr C_ElementPadAddedCallback
wrapped'' <- C_ElementPadAddedCallback -> IO (FunPtr C_ElementPadAddedCallback)
mk_ElementPadRemovedCallback C_ElementPadAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_ElementPadAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"pad-removed" FunPtr C_ElementPadAddedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [padRemoved](#signal:padRemoved) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' element #padRemoved callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterElementPadRemoved :: (IsElement a, MonadIO m) => a -> ((?self :: a) => ElementPadRemovedCallback) -> m SignalHandlerId
afterElementPadRemoved :: forall a (m :: * -> *).
(IsElement a, MonadIO m) =>
a -> ((?self::a) => ElementPadAddedCallback) -> m SignalHandlerId
afterElementPadRemoved a
obj (?self::a) => ElementPadAddedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ElementPadAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ElementPadAddedCallback
ElementPadAddedCallback
cb
    let wrapped' :: C_ElementPadAddedCallback
wrapped' = (a -> ElementPadAddedCallback) -> C_ElementPadAddedCallback
forall a.
GObject a =>
(a -> ElementPadAddedCallback) -> C_ElementPadAddedCallback
wrap_ElementPadRemovedCallback a -> ElementPadAddedCallback
wrapped
    FunPtr C_ElementPadAddedCallback
wrapped'' <- C_ElementPadAddedCallback -> IO (FunPtr C_ElementPadAddedCallback)
mk_ElementPadRemovedCallback C_ElementPadAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_ElementPadAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"pad-removed" FunPtr C_ElementPadAddedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ElementPadRemovedSignalInfo
instance SignalInfo ElementPadRemovedSignalInfo where
    type HaskellCallbackType ElementPadRemovedSignalInfo = ElementPadRemovedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ElementPadRemovedCallback cb
        cb'' <- mk_ElementPadRemovedCallback cb'
        connectSignalFunPtr obj "pad-removed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element::pad-removed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#g:signal:padRemoved"})

#endif

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

#if defined(ENABLE_OVERLOADING)
#endif

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

#endif

-- method Element::abort_state
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstElement to abort the state of."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_element_abort_state" gst_element_abort_state :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    IO ()

-- | Abort the state change of the element. This function is used
-- by elements that do asynchronous state changes and find out
-- something is wrong.
-- 
-- This function should be called with the STATE_LOCK held.
-- 
-- MT safe.
elementAbortState ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element' to abort the state of.
    -> m ()
elementAbortState :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsElement a) =>
a -> m ()
elementAbortState a
element = 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 Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    Ptr Element -> IO ()
gst_element_abort_state Ptr Element
element'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
element
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ElementAbortStateMethodInfo
instance (signature ~ (m ()), MonadIO m, IsElement a) => O.OverloadedMethod ElementAbortStateMethodInfo a signature where
    overloadedMethod = elementAbortState

instance O.OverloadedMethodInfo ElementAbortStateMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementAbortState",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementAbortState"
        })


#endif

-- method Element::add_pad
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstElement to add the pad to."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstPad to add to the element."
--                 , 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_element_add_pad" gst_element_add_pad :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    Ptr Gst.Pad.Pad ->                      -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    IO CInt

-- | Adds a pad (link point) to /@element@/. /@pad@/\'s parent will be set to /@element@/;
-- see 'GI.Gst.Objects.Object.objectSetParent' for refcounting information.
-- 
-- Pads are automatically activated when added in the PAUSED or PLAYING
-- state.
-- 
-- The pad and the element should be unlocked when calling this function.
-- 
-- This function will emit the [Element::padAdded]("GI.Gst.Objects.Element#g:signal:padAdded") signal on the element.
elementAddPad ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a, Gst.Pad.IsPad b) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element' to add the pad to.
    -> b
    -- ^ /@pad@/: the t'GI.Gst.Objects.Pad.Pad' to add to the element.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the pad could be added. This function can fail when
    -- a pad with the same name already existed or the pad already had another
    -- parent.
    -- 
    -- MT safe.
elementAddPad :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsElement a, IsPad b) =>
a -> b -> m Bool
elementAddPad a
element b
pad = 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 Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    Ptr Pad
pad' <- b -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
pad
    CInt
result <- Ptr Element -> Ptr Pad -> IO CInt
gst_element_add_pad Ptr Element
element' Ptr Pad
pad'
    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
element
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
pad
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ElementAddPadMethodInfo
instance (signature ~ (b -> m Bool), MonadIO m, IsElement a, Gst.Pad.IsPad b) => O.OverloadedMethod ElementAddPadMethodInfo a signature where
    overloadedMethod = elementAddPad

instance O.OverloadedMethodInfo ElementAddPadMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementAddPad",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementAddPad"
        })


#endif

-- method Element::add_property_deep_notify_watch
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GstElement to watch (recursively) for property changes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "name of property to watch for changes, or\n    NULL to watch all properties"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "include_value"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "whether to include the new property value in the message"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TULong)
-- throws : False
-- Skip return : False

foreign import ccall "gst_element_add_property_deep_notify_watch" gst_element_add_property_deep_notify_watch :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    CString ->                              -- property_name : TBasicType TUTF8
    CInt ->                                 -- include_value : TBasicType TBoolean
    IO CULong

-- | /No description available in the introspection data./
-- 
-- /Since: 1.10/
elementAddPropertyDeepNotifyWatch ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element' to watch (recursively) for property changes
    -> Maybe (T.Text)
    -- ^ /@propertyName@/: name of property to watch for changes, or
    --     NULL to watch all properties
    -> Bool
    -- ^ /@includeValue@/: whether to include the new property value in the message
    -> m CULong
    -- ^ __Returns:__ a watch id, which can be used in connection with
    --     'GI.Gst.Objects.Element.elementRemovePropertyNotifyWatch' to remove the watch again.
elementAddPropertyDeepNotifyWatch :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsElement a) =>
a -> Maybe Text -> Bool -> m SignalHandlerId
elementAddPropertyDeepNotifyWatch a
element Maybe Text
propertyName Bool
includeValue = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    Ptr Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    Ptr CChar
maybePropertyName <- case Maybe Text
propertyName of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jPropertyName -> do
            Ptr CChar
jPropertyName' <- Text -> IO (Ptr CChar)
textToCString Text
jPropertyName
            Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jPropertyName'
    let includeValue' :: CInt
includeValue' = (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
includeValue
    SignalHandlerId
result <- Ptr Element -> Ptr CChar -> CInt -> IO SignalHandlerId
gst_element_add_property_deep_notify_watch Ptr Element
element' Ptr CChar
maybePropertyName CInt
includeValue'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
element
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybePropertyName
    SignalHandlerId -> IO SignalHandlerId
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SignalHandlerId
result

#if defined(ENABLE_OVERLOADING)
data ElementAddPropertyDeepNotifyWatchMethodInfo
instance (signature ~ (Maybe (T.Text) -> Bool -> m CULong), MonadIO m, IsElement a) => O.OverloadedMethod ElementAddPropertyDeepNotifyWatchMethodInfo a signature where
    overloadedMethod = elementAddPropertyDeepNotifyWatch

instance O.OverloadedMethodInfo ElementAddPropertyDeepNotifyWatchMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementAddPropertyDeepNotifyWatch",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementAddPropertyDeepNotifyWatch"
        })


#endif

-- method Element::add_property_notify_watch
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstElement to watch for property changes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "name of property to watch for changes, or\n    NULL to watch all properties"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "include_value"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "whether to include the new property value in the message"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TULong)
-- throws : False
-- Skip return : False

foreign import ccall "gst_element_add_property_notify_watch" gst_element_add_property_notify_watch :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    CString ->                              -- property_name : TBasicType TUTF8
    CInt ->                                 -- include_value : TBasicType TBoolean
    IO CULong

-- | /No description available in the introspection data./
-- 
-- /Since: 1.10/
elementAddPropertyNotifyWatch ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element' to watch for property changes
    -> Maybe (T.Text)
    -- ^ /@propertyName@/: name of property to watch for changes, or
    --     NULL to watch all properties
    -> Bool
    -- ^ /@includeValue@/: whether to include the new property value in the message
    -> m CULong
    -- ^ __Returns:__ a watch id, which can be used in connection with
    --     'GI.Gst.Objects.Element.elementRemovePropertyNotifyWatch' to remove the watch again.
elementAddPropertyNotifyWatch :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsElement a) =>
a -> Maybe Text -> Bool -> m SignalHandlerId
elementAddPropertyNotifyWatch a
element Maybe Text
propertyName Bool
includeValue = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    Ptr Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    Ptr CChar
maybePropertyName <- case Maybe Text
propertyName of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jPropertyName -> do
            Ptr CChar
jPropertyName' <- Text -> IO (Ptr CChar)
textToCString Text
jPropertyName
            Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jPropertyName'
    let includeValue' :: CInt
includeValue' = (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
includeValue
    SignalHandlerId
result <- Ptr Element -> Ptr CChar -> CInt -> IO SignalHandlerId
gst_element_add_property_notify_watch Ptr Element
element' Ptr CChar
maybePropertyName CInt
includeValue'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
element
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybePropertyName
    SignalHandlerId -> IO SignalHandlerId
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SignalHandlerId
result

#if defined(ENABLE_OVERLOADING)
data ElementAddPropertyNotifyWatchMethodInfo
instance (signature ~ (Maybe (T.Text) -> Bool -> m CULong), MonadIO m, IsElement a) => O.OverloadedMethod ElementAddPropertyNotifyWatchMethodInfo a signature where
    overloadedMethod = elementAddPropertyNotifyWatch

instance O.OverloadedMethodInfo ElementAddPropertyNotifyWatchMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementAddPropertyNotifyWatch",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementAddPropertyNotifyWatch"
        })


#endif

-- method Element::call_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstElement" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "func"
--           , argType =
--               TInterface
--                 Name { namespace = "Gst" , name = "ElementCallAsyncFunc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "Function to call asynchronously from another thread"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = 2
--           , argDestroy = 3
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Data to pass to @func"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "destroy_notify"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "GDestroyNotify for @user_data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_element_call_async" gst_element_call_async :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    FunPtr Gst.Callbacks.C_ElementCallAsyncFunc -> -- func : TInterface (Name {namespace = "Gst", name = "ElementCallAsyncFunc"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- destroy_notify : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO ()

-- | Calls /@func@/ from another thread and passes /@userData@/ to it. This is to be
-- used for cases when a state change has to be performed from a streaming
-- thread, directly via 'GI.Gst.Objects.Element.elementSetState' or indirectly e.g. via SEEK
-- events.
-- 
-- Calling those functions directly from the streaming thread will cause
-- deadlocks in many situations, as they might involve waiting for the
-- streaming thread to shut down from this very streaming thread.
-- 
-- MT safe.
-- 
-- /Since: 1.10/
elementCallAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element'
    -> Gst.Callbacks.ElementCallAsyncFunc
    -- ^ /@func@/: Function to call asynchronously from another thread
    -> m ()
elementCallAsync :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsElement a) =>
a -> (Element -> IO ()) -> m ()
elementCallAsync a
element Element -> IO ()
func = 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 Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    FunPtr C_ElementNoMorePadsCallback
func' <- C_ElementNoMorePadsCallback
-> IO (FunPtr C_ElementNoMorePadsCallback)
Gst.Callbacks.mk_ElementCallAsyncFunc (Maybe (Ptr (FunPtr C_ElementNoMorePadsCallback))
-> ElementCallAsyncFunc_WithClosures -> C_ElementNoMorePadsCallback
Gst.Callbacks.wrap_ElementCallAsyncFunc Maybe (Ptr (FunPtr C_ElementNoMorePadsCallback))
forall a. Maybe a
Nothing ((Element -> IO ()) -> ElementCallAsyncFunc_WithClosures
Gst.Callbacks.drop_closures_ElementCallAsyncFunc Element -> IO ()
func))
    let userData :: Ptr ()
userData = FunPtr C_ElementNoMorePadsCallback -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_ElementNoMorePadsCallback
func'
    let destroyNotify :: FunPtr (Ptr a -> IO ())
destroyNotify = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
SP.safeFreeFunPtrPtr
    Ptr Element
-> FunPtr C_ElementNoMorePadsCallback
-> Ptr ()
-> FunPtr C_DestroyNotify
-> IO ()
gst_element_call_async Ptr Element
element' FunPtr C_ElementNoMorePadsCallback
func' Ptr ()
userData FunPtr C_DestroyNotify
forall a. FunPtr (Ptr a -> IO ())
destroyNotify
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
element
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ElementCallAsyncMethodInfo
instance (signature ~ (Gst.Callbacks.ElementCallAsyncFunc -> m ()), MonadIO m, IsElement a) => O.OverloadedMethod ElementCallAsyncMethodInfo a signature where
    overloadedMethod = elementCallAsync

instance O.OverloadedMethodInfo ElementCallAsyncMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementCallAsync",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementCallAsync"
        })


#endif

-- method Element::change_state
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstElement" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "transition"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "StateChange" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the requested transition"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Gst" , name = "StateChangeReturn" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_element_change_state" gst_element_change_state :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    CUInt ->                                -- transition : TInterface (Name {namespace = "Gst", name = "StateChange"})
    IO CUInt

-- | Perform /@transition@/ on /@element@/.
-- 
-- This function must be called with STATE_LOCK held and is mainly used
-- internally.
elementChangeState ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element'
    -> Gst.Enums.StateChange
    -- ^ /@transition@/: the requested transition
    -> m Gst.Enums.StateChangeReturn
    -- ^ __Returns:__ the t'GI.Gst.Enums.StateChangeReturn' of the state transition.
elementChangeState :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsElement a) =>
a -> StateChange -> m StateChangeReturn
elementChangeState a
element StateChange
transition = IO StateChangeReturn -> m StateChangeReturn
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO StateChangeReturn -> m StateChangeReturn)
-> IO StateChangeReturn -> m StateChangeReturn
forall a b. (a -> b) -> a -> b
$ do
    Ptr Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    let transition' :: CUInt
transition' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (StateChange -> Int) -> StateChange -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateChange -> Int
forall a. Enum a => a -> Int
fromEnum) StateChange
transition
    CUInt
result <- Ptr Element -> CUInt -> IO CUInt
gst_element_change_state Ptr Element
element' CUInt
transition'
    let result' :: StateChangeReturn
result' = (Int -> StateChangeReturn
forall a. Enum a => Int -> a
toEnum (Int -> StateChangeReturn)
-> (CUInt -> Int) -> CUInt -> StateChangeReturn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
element
    StateChangeReturn -> IO StateChangeReturn
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return StateChangeReturn
result'

#if defined(ENABLE_OVERLOADING)
data ElementChangeStateMethodInfo
instance (signature ~ (Gst.Enums.StateChange -> m Gst.Enums.StateChangeReturn), MonadIO m, IsElement a) => O.OverloadedMethod ElementChangeStateMethodInfo a signature where
    overloadedMethod = elementChangeState

instance O.OverloadedMethodInfo ElementChangeStateMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementChangeState",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementChangeState"
        })


#endif

-- method Element::continue_state
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GstElement to continue the state change of."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "ret"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "StateChangeReturn" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The previous state return value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Gst" , name = "StateChangeReturn" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_element_continue_state" gst_element_continue_state :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    CUInt ->                                -- ret : TInterface (Name {namespace = "Gst", name = "StateChangeReturn"})
    IO CUInt

-- | Commit the state change of the element and proceed to the next
-- pending state if any. This function is used
-- by elements that do asynchronous state changes.
-- The core will normally call this method automatically when an
-- element returned 'GI.Gst.Enums.StateChangeReturnSuccess' from the state change function.
-- 
-- If after calling this method the element still has not reached
-- the pending state, the next state change is performed.
-- 
-- This method is used internally and should normally not be called by plugins
-- or applications.
-- 
-- This function must be called with STATE_LOCK held.
elementContinueState ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element' to continue the state change of.
    -> Gst.Enums.StateChangeReturn
    -- ^ /@ret@/: The previous state return value
    -> m Gst.Enums.StateChangeReturn
    -- ^ __Returns:__ The result of the commit state change.
    -- 
    -- MT safe.
elementContinueState :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsElement a) =>
a -> StateChangeReturn -> m StateChangeReturn
elementContinueState a
element StateChangeReturn
ret = IO StateChangeReturn -> m StateChangeReturn
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO StateChangeReturn -> m StateChangeReturn)
-> IO StateChangeReturn -> m StateChangeReturn
forall a b. (a -> b) -> a -> b
$ do
    Ptr Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    let ret' :: CUInt
ret' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (StateChangeReturn -> Int) -> StateChangeReturn -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateChangeReturn -> Int
forall a. Enum a => a -> Int
fromEnum) StateChangeReturn
ret
    CUInt
result <- Ptr Element -> CUInt -> IO CUInt
gst_element_continue_state Ptr Element
element' CUInt
ret'
    let result' :: StateChangeReturn
result' = (Int -> StateChangeReturn
forall a. Enum a => Int -> a
toEnum (Int -> StateChangeReturn)
-> (CUInt -> Int) -> CUInt -> StateChangeReturn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
element
    StateChangeReturn -> IO StateChangeReturn
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return StateChangeReturn
result'

#if defined(ENABLE_OVERLOADING)
data ElementContinueStateMethodInfo
instance (signature ~ (Gst.Enums.StateChangeReturn -> m Gst.Enums.StateChangeReturn), MonadIO m, IsElement a) => O.OverloadedMethod ElementContinueStateMethodInfo a signature where
    overloadedMethod = elementContinueState

instance O.OverloadedMethodInfo ElementContinueStateMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementContinueState",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementContinueState"
        })


#endif

-- method Element::create_all_pads
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstElement to create pads for"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_element_create_all_pads" gst_element_create_all_pads :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    IO ()

-- | Creates a pad for each pad template that is always available.
-- This function is only useful during object initialization of
-- subclasses of t'GI.Gst.Objects.Element.Element'.
elementCreateAllPads ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element' to create pads for
    -> m ()
elementCreateAllPads :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsElement a) =>
a -> m ()
elementCreateAllPads a
element = 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 Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    Ptr Element -> IO ()
gst_element_create_all_pads Ptr Element
element'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
element
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ElementCreateAllPadsMethodInfo
instance (signature ~ (m ()), MonadIO m, IsElement a) => O.OverloadedMethod ElementCreateAllPadsMethodInfo a signature where
    overloadedMethod = elementCreateAllPads

instance O.OverloadedMethodInfo ElementCreateAllPadsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementCreateAllPads",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementCreateAllPads"
        })


#endif

-- method Element::foreach_pad
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstElement to iterate pads of"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "func"
--           , argType =
--               TInterface
--                 Name { namespace = "Gst" , name = "ElementForeachPadFunc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "function to call for each pad"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeCall
--           , argClosure = 2
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data passed to @func"
--                 , 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_element_foreach_pad" gst_element_foreach_pad :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    FunPtr Gst.Callbacks.C_ElementForeachPadFunc -> -- func : TInterface (Name {namespace = "Gst", name = "ElementForeachPadFunc"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO CInt

-- | Call /@func@/ with /@userData@/ for each of /@element@/\'s pads. /@func@/ will be called
-- exactly once for each pad that exists at the time of this call, unless
-- one of the calls to /@func@/ returns 'P.False' in which case we will stop
-- iterating pads and return early. If new pads are added or pads are removed
-- while pads are being iterated, this will not be taken into account until
-- next time this function is used.
-- 
-- /Since: 1.14/
elementForeachPad ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element' to iterate pads of
    -> Gst.Callbacks.ElementForeachPadFunc
    -- ^ /@func@/: function to call for each pad
    -> m Bool
    -- ^ __Returns:__ 'P.False' if /@element@/ had no pads or if one of the calls to /@func@/
    --   returned 'P.False'.
elementForeachPad :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsElement a) =>
a -> ElementForeachPadFunc -> m Bool
elementForeachPad a
element ElementForeachPadFunc
func = 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 Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    FunPtr C_ElementForeachPadFunc
func' <- C_ElementForeachPadFunc -> IO (FunPtr C_ElementForeachPadFunc)
Gst.Callbacks.mk_ElementForeachPadFunc (Maybe (Ptr (FunPtr C_ElementForeachPadFunc))
-> ElementForeachPadFunc_WithClosures -> C_ElementForeachPadFunc
Gst.Callbacks.wrap_ElementForeachPadFunc Maybe (Ptr (FunPtr C_ElementForeachPadFunc))
forall a. Maybe a
Nothing (ElementForeachPadFunc -> ElementForeachPadFunc_WithClosures
Gst.Callbacks.drop_closures_ElementForeachPadFunc ElementForeachPadFunc
func))
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    CInt
result <- Ptr Element -> FunPtr C_ElementForeachPadFunc -> Ptr () -> IO CInt
gst_element_foreach_pad Ptr Element
element' FunPtr C_ElementForeachPadFunc
func' Ptr ()
forall a. Ptr a
userData
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_ElementForeachPadFunc -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_ElementForeachPadFunc
func'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
element
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ElementForeachPadMethodInfo
instance (signature ~ (Gst.Callbacks.ElementForeachPadFunc -> m Bool), MonadIO m, IsElement a) => O.OverloadedMethod ElementForeachPadMethodInfo a signature where
    overloadedMethod = elementForeachPad

instance O.OverloadedMethodInfo ElementForeachPadMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementForeachPad",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementForeachPad"
        })


#endif

-- method Element::foreach_sink_pad
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstElement to iterate sink pads of"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "func"
--           , argType =
--               TInterface
--                 Name { namespace = "Gst" , name = "ElementForeachPadFunc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "function to call for each sink pad"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeCall
--           , argClosure = 2
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data passed to @func"
--                 , 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_element_foreach_sink_pad" gst_element_foreach_sink_pad :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    FunPtr Gst.Callbacks.C_ElementForeachPadFunc -> -- func : TInterface (Name {namespace = "Gst", name = "ElementForeachPadFunc"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO CInt

-- | Call /@func@/ with /@userData@/ for each of /@element@/\'s sink pads. /@func@/ will be
-- called exactly once for each sink pad that exists at the time of this call,
-- unless one of the calls to /@func@/ returns 'P.False' in which case we will stop
-- iterating pads and return early. If new sink pads are added or sink pads
-- are removed while the sink pads are being iterated, this will not be taken
-- into account until next time this function is used.
-- 
-- /Since: 1.14/
elementForeachSinkPad ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element' to iterate sink pads of
    -> Gst.Callbacks.ElementForeachPadFunc
    -- ^ /@func@/: function to call for each sink pad
    -> m Bool
    -- ^ __Returns:__ 'P.False' if /@element@/ had no sink pads or if one of the calls to /@func@/
    --   returned 'P.False'.
elementForeachSinkPad :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsElement a) =>
a -> ElementForeachPadFunc -> m Bool
elementForeachSinkPad a
element ElementForeachPadFunc
func = 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 Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    FunPtr C_ElementForeachPadFunc
func' <- C_ElementForeachPadFunc -> IO (FunPtr C_ElementForeachPadFunc)
Gst.Callbacks.mk_ElementForeachPadFunc (Maybe (Ptr (FunPtr C_ElementForeachPadFunc))
-> ElementForeachPadFunc_WithClosures -> C_ElementForeachPadFunc
Gst.Callbacks.wrap_ElementForeachPadFunc Maybe (Ptr (FunPtr C_ElementForeachPadFunc))
forall a. Maybe a
Nothing (ElementForeachPadFunc -> ElementForeachPadFunc_WithClosures
Gst.Callbacks.drop_closures_ElementForeachPadFunc ElementForeachPadFunc
func))
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    CInt
result <- Ptr Element -> FunPtr C_ElementForeachPadFunc -> Ptr () -> IO CInt
gst_element_foreach_sink_pad Ptr Element
element' FunPtr C_ElementForeachPadFunc
func' Ptr ()
forall a. Ptr a
userData
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_ElementForeachPadFunc -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_ElementForeachPadFunc
func'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
element
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ElementForeachSinkPadMethodInfo
instance (signature ~ (Gst.Callbacks.ElementForeachPadFunc -> m Bool), MonadIO m, IsElement a) => O.OverloadedMethod ElementForeachSinkPadMethodInfo a signature where
    overloadedMethod = elementForeachSinkPad

instance O.OverloadedMethodInfo ElementForeachSinkPadMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementForeachSinkPad",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementForeachSinkPad"
        })


#endif

-- method Element::foreach_src_pad
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstElement to iterate source pads of"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "func"
--           , argType =
--               TInterface
--                 Name { namespace = "Gst" , name = "ElementForeachPadFunc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "function to call for each source pad"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeCall
--           , argClosure = 2
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data passed to @func"
--                 , 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_element_foreach_src_pad" gst_element_foreach_src_pad :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    FunPtr Gst.Callbacks.C_ElementForeachPadFunc -> -- func : TInterface (Name {namespace = "Gst", name = "ElementForeachPadFunc"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO CInt

-- | Call /@func@/ with /@userData@/ for each of /@element@/\'s source pads. /@func@/ will be
-- called exactly once for each source pad that exists at the time of this call,
-- unless one of the calls to /@func@/ returns 'P.False' in which case we will stop
-- iterating pads and return early. If new source pads are added or source pads
-- are removed while the source pads are being iterated, this will not be taken
-- into account until next time this function is used.
-- 
-- /Since: 1.14/
elementForeachSrcPad ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element' to iterate source pads of
    -> Gst.Callbacks.ElementForeachPadFunc
    -- ^ /@func@/: function to call for each source pad
    -> m Bool
    -- ^ __Returns:__ 'P.False' if /@element@/ had no source pads or if one of the calls
    --   to /@func@/ returned 'P.False'.
elementForeachSrcPad :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsElement a) =>
a -> ElementForeachPadFunc -> m Bool
elementForeachSrcPad a
element ElementForeachPadFunc
func = 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 Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    FunPtr C_ElementForeachPadFunc
func' <- C_ElementForeachPadFunc -> IO (FunPtr C_ElementForeachPadFunc)
Gst.Callbacks.mk_ElementForeachPadFunc (Maybe (Ptr (FunPtr C_ElementForeachPadFunc))
-> ElementForeachPadFunc_WithClosures -> C_ElementForeachPadFunc
Gst.Callbacks.wrap_ElementForeachPadFunc Maybe (Ptr (FunPtr C_ElementForeachPadFunc))
forall a. Maybe a
Nothing (ElementForeachPadFunc -> ElementForeachPadFunc_WithClosures
Gst.Callbacks.drop_closures_ElementForeachPadFunc ElementForeachPadFunc
func))
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    CInt
result <- Ptr Element -> FunPtr C_ElementForeachPadFunc -> Ptr () -> IO CInt
gst_element_foreach_src_pad Ptr Element
element' FunPtr C_ElementForeachPadFunc
func' Ptr ()
forall a. Ptr a
userData
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_ElementForeachPadFunc -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_ElementForeachPadFunc
func'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
element
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ElementForeachSrcPadMethodInfo
instance (signature ~ (Gst.Callbacks.ElementForeachPadFunc -> m Bool), MonadIO m, IsElement a) => O.OverloadedMethod ElementForeachSrcPadMethodInfo a signature where
    overloadedMethod = elementForeachSrcPad

instance O.OverloadedMethodInfo ElementForeachSrcPadMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementForeachSrcPad",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementForeachSrcPad"
        })


#endif

-- method Element::get_base_time
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstElement." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt64)
-- throws : False
-- Skip return : False

foreign import ccall "gst_element_get_base_time" gst_element_get_base_time :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    IO Word64

-- | Returns the base time of the element. The base time is the
-- absolute time of the clock when this element was last put to
-- PLAYING. Subtracting the base time from the clock time gives
-- the running time of the element.
elementGetBaseTime ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element'.
    -> m Word64
    -- ^ __Returns:__ the base time of the element.
    -- 
    -- MT safe.
elementGetBaseTime :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsElement a) =>
a -> m Word64
elementGetBaseTime a
element = IO Word64 -> m Word64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
    Ptr Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    Word64
result <- Ptr Element -> IO Word64
gst_element_get_base_time Ptr Element
element'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
element
    Word64 -> IO Word64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data ElementGetBaseTimeMethodInfo
instance (signature ~ (m Word64), MonadIO m, IsElement a) => O.OverloadedMethod ElementGetBaseTimeMethodInfo a signature where
    overloadedMethod = elementGetBaseTime

instance O.OverloadedMethodInfo ElementGetBaseTimeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementGetBaseTime",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementGetBaseTime"
        })


#endif

-- method Element::get_bus
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstElement to get the bus of."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Bus" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_element_get_bus" gst_element_get_bus :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    IO (Ptr Gst.Bus.Bus)

-- | Returns the bus of the element. Note that only a t'GI.Gst.Objects.Pipeline.Pipeline' will provide a
-- bus for the application.
elementGetBus ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element' to get the bus of.
    -> m (Maybe Gst.Bus.Bus)
    -- ^ __Returns:__ the element\'s t'GI.Gst.Objects.Bus.Bus'. unref after
    -- usage.
    -- 
    -- MT safe.
elementGetBus :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsElement a) =>
a -> m (Maybe Bus)
elementGetBus a
element = IO (Maybe Bus) -> m (Maybe Bus)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Bus) -> m (Maybe Bus))
-> IO (Maybe Bus) -> m (Maybe Bus)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    Ptr Bus
result <- Ptr Element -> IO (Ptr Bus)
gst_element_get_bus Ptr Element
element'
    Maybe Bus
maybeResult <- Ptr Bus -> (Ptr Bus -> IO Bus) -> IO (Maybe Bus)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Bus
result ((Ptr Bus -> IO Bus) -> IO (Maybe Bus))
-> (Ptr Bus -> IO Bus) -> IO (Maybe Bus)
forall a b. (a -> b) -> a -> b
$ \Ptr Bus
result' -> do
        Bus
result'' <- ((ManagedPtr Bus -> Bus) -> Ptr Bus -> IO Bus
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Bus -> Bus
Gst.Bus.Bus) Ptr Bus
result'
        Bus -> IO Bus
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bus
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
element
    Maybe Bus -> IO (Maybe Bus)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Bus
maybeResult

#if defined(ENABLE_OVERLOADING)
data ElementGetBusMethodInfo
instance (signature ~ (m (Maybe Gst.Bus.Bus)), MonadIO m, IsElement a) => O.OverloadedMethod ElementGetBusMethodInfo a signature where
    overloadedMethod = elementGetBus

instance O.OverloadedMethodInfo ElementGetBusMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementGetBus",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementGetBus"
        })


#endif

-- method Element::get_clock
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstElement to get the clock of."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Clock" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_element_get_clock" gst_element_get_clock :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    IO (Ptr Gst.Clock.Clock)

-- | Gets the currently configured clock of the element. This is the clock as was
-- last set with 'GI.Gst.Objects.Element.elementSetClock'.
-- 
-- Elements in a pipeline will only have their clock set when the
-- pipeline is in the PLAYING state.
elementGetClock ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element' to get the clock of.
    -> m (Maybe Gst.Clock.Clock)
    -- ^ __Returns:__ the t'GI.Gst.Objects.Clock.Clock' of the element. unref after usage.
    -- 
    -- MT safe.
elementGetClock :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsElement a) =>
a -> m (Maybe Clock)
elementGetClock a
element = IO (Maybe Clock) -> m (Maybe Clock)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Clock) -> m (Maybe Clock))
-> IO (Maybe Clock) -> m (Maybe Clock)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    Ptr Clock
result <- Ptr Element -> IO (Ptr Clock)
gst_element_get_clock Ptr Element
element'
    Maybe Clock
maybeResult <- Ptr Clock -> (Ptr Clock -> IO Clock) -> IO (Maybe Clock)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Clock
result ((Ptr Clock -> IO Clock) -> IO (Maybe Clock))
-> (Ptr Clock -> IO Clock) -> IO (Maybe Clock)
forall a b. (a -> b) -> a -> b
$ \Ptr Clock
result' -> do
        Clock
result'' <- ((ManagedPtr Clock -> Clock) -> Ptr Clock -> IO Clock
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Clock -> Clock
Gst.Clock.Clock) Ptr Clock
result'
        Clock -> IO Clock
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Clock
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
element
    Maybe Clock -> IO (Maybe Clock)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Clock
maybeResult

#if defined(ENABLE_OVERLOADING)
data ElementGetClockMethodInfo
instance (signature ~ (m (Maybe Gst.Clock.Clock)), MonadIO m, IsElement a) => O.OverloadedMethod ElementGetClockMethodInfo a signature where
    overloadedMethod = elementGetClock

instance O.OverloadedMethodInfo ElementGetClockMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementGetClock",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementGetClock"
        })


#endif

-- method Element::get_compatible_pad
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GstElement in which the pad should be found."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstPad to find a compatible one for."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "caps"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstCaps to use as a filter."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Pad" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_element_get_compatible_pad" gst_element_get_compatible_pad :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    Ptr Gst.Pad.Pad ->                      -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    Ptr Gst.Caps.Caps ->                    -- caps : TInterface (Name {namespace = "Gst", name = "Caps"})
    IO (Ptr Gst.Pad.Pad)

-- | Looks for an unlinked pad to which the given pad can link. It is not
-- guaranteed that linking the pads will work, though it should work in most
-- cases.
-- 
-- This function will first attempt to find a compatible unlinked ALWAYS pad,
-- and if none can be found, it will request a compatible REQUEST pad by looking
-- at the templates of /@element@/.
elementGetCompatiblePad ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a, Gst.Pad.IsPad b) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element' in which the pad should be found.
    -> b
    -- ^ /@pad@/: the t'GI.Gst.Objects.Pad.Pad' to find a compatible one for.
    -> Maybe (Gst.Caps.Caps)
    -- ^ /@caps@/: the t'GI.Gst.Structs.Caps.Caps' to use as a filter.
    -> m (Maybe Gst.Pad.Pad)
    -- ^ __Returns:__ the t'GI.Gst.Objects.Pad.Pad' to which a link
    --   can be made, or 'P.Nothing' if one cannot be found. 'GI.Gst.Objects.Object.objectUnref'
    --   after usage.
elementGetCompatiblePad :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsElement a, IsPad b) =>
a -> b -> Maybe Caps -> m (Maybe Pad)
elementGetCompatiblePad a
element b
pad Maybe Caps
caps = IO (Maybe Pad) -> m (Maybe Pad)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Pad) -> m (Maybe Pad))
-> IO (Maybe Pad) -> m (Maybe Pad)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    Ptr Pad
pad' <- b -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
pad
    Ptr Caps
maybeCaps <- case Maybe Caps
caps of
        Maybe Caps
Nothing -> Ptr Caps -> IO (Ptr Caps)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Caps
forall a. Ptr a
nullPtr
        Just Caps
jCaps -> do
            Ptr Caps
jCaps' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
jCaps
            Ptr Caps -> IO (Ptr Caps)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Caps
jCaps'
    Ptr Pad
result <- Ptr Element -> Ptr Pad -> Ptr Caps -> IO (Ptr Pad)
gst_element_get_compatible_pad Ptr Element
element' Ptr Pad
pad' Ptr Caps
maybeCaps
    Maybe Pad
maybeResult <- Ptr Pad -> (Ptr Pad -> IO Pad) -> IO (Maybe Pad)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Pad
result ((Ptr Pad -> IO Pad) -> IO (Maybe Pad))
-> (Ptr Pad -> IO Pad) -> IO (Maybe Pad)
forall a b. (a -> b) -> a -> b
$ \Ptr Pad
result' -> do
        Pad
result'' <- ((ManagedPtr Pad -> Pad) -> Ptr Pad -> IO Pad
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Pad -> Pad
Gst.Pad.Pad) Ptr Pad
result'
        Pad -> IO Pad
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Pad
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
element
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
pad
    Maybe Caps -> (Caps -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Caps
caps Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe Pad -> IO (Maybe Pad)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Pad
maybeResult

#if defined(ENABLE_OVERLOADING)
data ElementGetCompatiblePadMethodInfo
instance (signature ~ (b -> Maybe (Gst.Caps.Caps) -> m (Maybe Gst.Pad.Pad)), MonadIO m, IsElement a, Gst.Pad.IsPad b) => O.OverloadedMethod ElementGetCompatiblePadMethodInfo a signature where
    overloadedMethod = elementGetCompatiblePad

instance O.OverloadedMethodInfo ElementGetCompatiblePadMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementGetCompatiblePad",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementGetCompatiblePad"
        })


#endif

-- method Element::get_compatible_pad_template
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GstElement to get a compatible pad template for"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "compattempl"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "PadTemplate" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the #GstPadTemplate to find a compatible\n    template for"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "PadTemplate" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_element_get_compatible_pad_template" gst_element_get_compatible_pad_template :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    Ptr Gst.PadTemplate.PadTemplate ->      -- compattempl : TInterface (Name {namespace = "Gst", name = "PadTemplate"})
    IO (Ptr Gst.PadTemplate.PadTemplate)

-- | Retrieves a pad template from /@element@/ that is compatible with /@compattempl@/.
-- Pads from compatible templates can be linked together.
elementGetCompatiblePadTemplate ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a, Gst.PadTemplate.IsPadTemplate b) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element' to get a compatible pad template for
    -> b
    -- ^ /@compattempl@/: the t'GI.Gst.Objects.PadTemplate.PadTemplate' to find a compatible
    --     template for
    -> m (Maybe Gst.PadTemplate.PadTemplate)
    -- ^ __Returns:__ a compatible t'GI.Gst.Objects.PadTemplate.PadTemplate',
    --   or 'P.Nothing' if none was found. No unreferencing is necessary.
elementGetCompatiblePadTemplate :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsElement a, IsPadTemplate b) =>
a -> b -> m (Maybe PadTemplate)
elementGetCompatiblePadTemplate a
element b
compattempl = IO (Maybe PadTemplate) -> m (Maybe PadTemplate)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe PadTemplate) -> m (Maybe PadTemplate))
-> IO (Maybe PadTemplate) -> m (Maybe PadTemplate)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    Ptr PadTemplate
compattempl' <- b -> IO (Ptr PadTemplate)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
compattempl
    Ptr PadTemplate
result <- Ptr Element -> Ptr PadTemplate -> IO (Ptr PadTemplate)
gst_element_get_compatible_pad_template Ptr Element
element' Ptr PadTemplate
compattempl'
    Maybe PadTemplate
maybeResult <- Ptr PadTemplate
-> (Ptr PadTemplate -> IO PadTemplate) -> IO (Maybe PadTemplate)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr PadTemplate
result ((Ptr PadTemplate -> IO PadTemplate) -> IO (Maybe PadTemplate))
-> (Ptr PadTemplate -> IO PadTemplate) -> IO (Maybe PadTemplate)
forall a b. (a -> b) -> a -> b
$ \Ptr PadTemplate
result' -> do
        PadTemplate
result'' <- ((ManagedPtr PadTemplate -> PadTemplate)
-> Ptr PadTemplate -> IO PadTemplate
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr PadTemplate -> PadTemplate
Gst.PadTemplate.PadTemplate) Ptr PadTemplate
result'
        PadTemplate -> IO PadTemplate
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PadTemplate
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
element
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
compattempl
    Maybe PadTemplate -> IO (Maybe PadTemplate)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe PadTemplate
maybeResult

#if defined(ENABLE_OVERLOADING)
data ElementGetCompatiblePadTemplateMethodInfo
instance (signature ~ (b -> m (Maybe Gst.PadTemplate.PadTemplate)), MonadIO m, IsElement a, Gst.PadTemplate.IsPadTemplate b) => O.OverloadedMethod ElementGetCompatiblePadTemplateMethodInfo a signature where
    overloadedMethod = elementGetCompatiblePadTemplate

instance O.OverloadedMethodInfo ElementGetCompatiblePadTemplateMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementGetCompatiblePadTemplate",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementGetCompatiblePadTemplate"
        })


#endif

-- method Element::get_context
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstElement to get the context of."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "context_type"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a name of a context to retrieve"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Context" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_element_get_context" gst_element_get_context :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    CString ->                              -- context_type : TBasicType TUTF8
    IO (Ptr Gst.Context.Context)

-- | Gets the context with /@contextType@/ set on the element or NULL.
-- 
-- MT safe.
-- 
-- /Since: 1.8/
elementGetContext ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element' to get the context of.
    -> T.Text
    -- ^ /@contextType@/: a name of a context to retrieve
    -> m (Maybe Gst.Context.Context)
    -- ^ __Returns:__ A t'GI.Gst.Structs.Context.Context' or NULL
elementGetContext :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsElement a) =>
a -> Text -> m (Maybe Context)
elementGetContext a
element Text
contextType = IO (Maybe Context) -> m (Maybe Context)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Context) -> m (Maybe Context))
-> IO (Maybe Context) -> m (Maybe Context)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    Ptr CChar
contextType' <- Text -> IO (Ptr CChar)
textToCString Text
contextType
    Ptr Context
result <- Ptr Element -> Ptr CChar -> IO (Ptr Context)
gst_element_get_context Ptr Element
element' Ptr CChar
contextType'
    Maybe Context
maybeResult <- Ptr Context -> (Ptr Context -> IO Context) -> IO (Maybe Context)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Context
result ((Ptr Context -> IO Context) -> IO (Maybe Context))
-> (Ptr Context -> IO Context) -> IO (Maybe Context)
forall a b. (a -> b) -> a -> b
$ \Ptr Context
result' -> do
        Context
result'' <- ((ManagedPtr Context -> Context) -> Ptr Context -> IO Context
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Context -> Context
Gst.Context.Context) Ptr Context
result'
        Context -> IO Context
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Context
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
element
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
contextType'
    Maybe Context -> IO (Maybe Context)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Context
maybeResult

#if defined(ENABLE_OVERLOADING)
data ElementGetContextMethodInfo
instance (signature ~ (T.Text -> m (Maybe Gst.Context.Context)), MonadIO m, IsElement a) => O.OverloadedMethod ElementGetContextMethodInfo a signature where
    overloadedMethod = elementGetContext

instance O.OverloadedMethodInfo ElementGetContextMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementGetContext",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementGetContext"
        })


#endif

-- method Element::get_context_unlocked
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstElement to get the context of."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "context_type"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a name of a context to retrieve"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Context" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_element_get_context_unlocked" gst_element_get_context_unlocked :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    CString ->                              -- context_type : TBasicType TUTF8
    IO (Ptr Gst.Context.Context)

-- | Gets the context with /@contextType@/ set on the element or NULL.
-- 
-- /Since: 1.8/
elementGetContextUnlocked ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element' to get the context of.
    -> T.Text
    -- ^ /@contextType@/: a name of a context to retrieve
    -> m (Maybe Gst.Context.Context)
    -- ^ __Returns:__ A t'GI.Gst.Structs.Context.Context' or NULL
elementGetContextUnlocked :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsElement a) =>
a -> Text -> m (Maybe Context)
elementGetContextUnlocked a
element Text
contextType = IO (Maybe Context) -> m (Maybe Context)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Context) -> m (Maybe Context))
-> IO (Maybe Context) -> m (Maybe Context)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    Ptr CChar
contextType' <- Text -> IO (Ptr CChar)
textToCString Text
contextType
    Ptr Context
result <- Ptr Element -> Ptr CChar -> IO (Ptr Context)
gst_element_get_context_unlocked Ptr Element
element' Ptr CChar
contextType'
    Maybe Context
maybeResult <- Ptr Context -> (Ptr Context -> IO Context) -> IO (Maybe Context)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Context
result ((Ptr Context -> IO Context) -> IO (Maybe Context))
-> (Ptr Context -> IO Context) -> IO (Maybe Context)
forall a b. (a -> b) -> a -> b
$ \Ptr Context
result' -> do
        Context
result'' <- ((ManagedPtr Context -> Context) -> Ptr Context -> IO Context
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Context -> Context
Gst.Context.Context) Ptr Context
result'
        Context -> IO Context
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Context
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
element
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
contextType'
    Maybe Context -> IO (Maybe Context)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Context
maybeResult

#if defined(ENABLE_OVERLOADING)
data ElementGetContextUnlockedMethodInfo
instance (signature ~ (T.Text -> m (Maybe Gst.Context.Context)), MonadIO m, IsElement a) => O.OverloadedMethod ElementGetContextUnlockedMethodInfo a signature where
    overloadedMethod = elementGetContextUnlocked

instance O.OverloadedMethodInfo ElementGetContextUnlockedMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementGetContextUnlocked",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementGetContextUnlocked"
        })


#endif

-- method Element::get_contexts
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstElement to set the context of."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList (TInterface Name { namespace = "Gst" , name = "Context" }))
-- throws : False
-- Skip return : False

foreign import ccall "gst_element_get_contexts" gst_element_get_contexts :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    IO (Ptr (GList (Ptr Gst.Context.Context)))

-- | Gets the contexts set on the element.
-- 
-- MT safe.
-- 
-- /Since: 1.8/
elementGetContexts ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element' to set the context of.
    -> m [Gst.Context.Context]
    -- ^ __Returns:__ List of t'GI.Gst.Structs.Context.Context'
elementGetContexts :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsElement a) =>
a -> m [Context]
elementGetContexts a
element = IO [Context] -> m [Context]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Context] -> m [Context]) -> IO [Context] -> m [Context]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    Ptr (GList (Ptr Context))
result <- Ptr Element -> IO (Ptr (GList (Ptr Context)))
gst_element_get_contexts Ptr Element
element'
    [Ptr Context]
result' <- Ptr (GList (Ptr Context)) -> IO [Ptr Context]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr Context))
result
    [Context]
result'' <- (Ptr Context -> IO Context) -> [Ptr Context] -> IO [Context]
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 Context -> Context) -> Ptr Context -> IO Context
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Context -> Context
Gst.Context.Context) [Ptr Context]
result'
    Ptr (GList (Ptr Context)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr Context))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
element
    [Context] -> IO [Context]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Context]
result''

#if defined(ENABLE_OVERLOADING)
data ElementGetContextsMethodInfo
instance (signature ~ (m [Gst.Context.Context]), MonadIO m, IsElement a) => O.OverloadedMethod ElementGetContextsMethodInfo a signature where
    overloadedMethod = elementGetContexts

instance O.OverloadedMethodInfo ElementGetContextsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementGetContexts",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementGetContexts"
        })


#endif

-- method Element::get_current_clock_time
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstElement." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt64)
-- throws : False
-- Skip return : False

foreign import ccall "gst_element_get_current_clock_time" gst_element_get_current_clock_time :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    IO Word64

-- | Returns the current clock time of the element, as in, the time of the
-- element\'s clock, or GST_CLOCK_TIME_NONE if there is no clock.
-- 
-- /Since: 1.18/
elementGetCurrentClockTime ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element'.
    -> m Word64
    -- ^ __Returns:__ the clock time of the element, or GST_CLOCK_TIME_NONE if there is
    -- no clock.
elementGetCurrentClockTime :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsElement a) =>
a -> m Word64
elementGetCurrentClockTime a
element = IO Word64 -> m Word64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
    Ptr Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    Word64
result <- Ptr Element -> IO Word64
gst_element_get_current_clock_time Ptr Element
element'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
element
    Word64 -> IO Word64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data ElementGetCurrentClockTimeMethodInfo
instance (signature ~ (m Word64), MonadIO m, IsElement a) => O.OverloadedMethod ElementGetCurrentClockTimeMethodInfo a signature where
    overloadedMethod = elementGetCurrentClockTime

instance O.OverloadedMethodInfo ElementGetCurrentClockTimeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementGetCurrentClockTime",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementGetCurrentClockTime"
        })


#endif

-- method Element::get_current_running_time
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstElement." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt64)
-- throws : False
-- Skip return : False

foreign import ccall "gst_element_get_current_running_time" gst_element_get_current_running_time :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    IO Word64

-- | Returns the running time of the element. The running time is the
-- element\'s clock time minus its base time. Will return GST_CLOCK_TIME_NONE
-- if the element has no clock, or if its base time has not been set.
-- 
-- /Since: 1.18/
elementGetCurrentRunningTime ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element'.
    -> m Word64
    -- ^ __Returns:__ the running time of the element, or GST_CLOCK_TIME_NONE if the
    -- element has no clock or its base time has not been set.
elementGetCurrentRunningTime :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsElement a) =>
a -> m Word64
elementGetCurrentRunningTime a
element = IO Word64 -> m Word64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
    Ptr Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    Word64
result <- Ptr Element -> IO Word64
gst_element_get_current_running_time Ptr Element
element'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
element
    Word64 -> IO Word64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data ElementGetCurrentRunningTimeMethodInfo
instance (signature ~ (m Word64), MonadIO m, IsElement a) => O.OverloadedMethod ElementGetCurrentRunningTimeMethodInfo a signature where
    overloadedMethod = elementGetCurrentRunningTime

instance O.OverloadedMethodInfo ElementGetCurrentRunningTimeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementGetCurrentRunningTime",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementGetCurrentRunningTime"
        })


#endif

-- method Element::get_factory
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GstElement to request the element factory of."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gst" , name = "ElementFactory" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_element_get_factory" gst_element_get_factory :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    IO (Ptr Gst.ElementFactory.ElementFactory)

-- | Retrieves the factory that was used to create this element.
elementGetFactory ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element' to request the element factory of.
    -> m (Maybe Gst.ElementFactory.ElementFactory)
    -- ^ __Returns:__ the t'GI.Gst.Objects.ElementFactory.ElementFactory' used for creating this
    --     element or 'P.Nothing' if element has not been registered (static element). no refcounting is needed.
elementGetFactory :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsElement a) =>
a -> m (Maybe ElementFactory)
elementGetFactory a
element = IO (Maybe ElementFactory) -> m (Maybe ElementFactory)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ElementFactory) -> m (Maybe ElementFactory))
-> IO (Maybe ElementFactory) -> m (Maybe ElementFactory)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    Ptr ElementFactory
result <- Ptr Element -> IO (Ptr ElementFactory)
gst_element_get_factory Ptr Element
element'
    Maybe ElementFactory
maybeResult <- Ptr ElementFactory
-> (Ptr ElementFactory -> IO ElementFactory)
-> IO (Maybe ElementFactory)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr ElementFactory
result ((Ptr ElementFactory -> IO ElementFactory)
 -> IO (Maybe ElementFactory))
-> (Ptr ElementFactory -> IO ElementFactory)
-> IO (Maybe ElementFactory)
forall a b. (a -> b) -> a -> b
$ \Ptr ElementFactory
result' -> do
        ElementFactory
result'' <- ((ManagedPtr ElementFactory -> ElementFactory)
-> Ptr ElementFactory -> IO ElementFactory
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ElementFactory -> ElementFactory
Gst.ElementFactory.ElementFactory) Ptr ElementFactory
result'
        ElementFactory -> IO ElementFactory
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ElementFactory
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
element
    Maybe ElementFactory -> IO (Maybe ElementFactory)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ElementFactory
maybeResult

#if defined(ENABLE_OVERLOADING)
data ElementGetFactoryMethodInfo
instance (signature ~ (m (Maybe Gst.ElementFactory.ElementFactory)), MonadIO m, IsElement a) => O.OverloadedMethod ElementGetFactoryMethodInfo a signature where
    overloadedMethod = elementGetFactory

instance O.OverloadedMethodInfo ElementGetFactoryMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementGetFactory",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementGetFactory"
        })


#endif

-- method Element::get_metadata
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "class to get metadata for"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "key"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the key to get" , 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_element_get_metadata" gst_element_get_metadata :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    CString ->                              -- key : TBasicType TUTF8
    IO CString

-- | Get metadata with /@key@/ in /@klass@/.
-- 
-- /Since: 1.14/
elementGetMetadata ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a) =>
    a
    -- ^ /@element@/: class to get metadata for
    -> T.Text
    -- ^ /@key@/: the key to get
    -> m T.Text
    -- ^ __Returns:__ the metadata for /@key@/.
elementGetMetadata :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsElement a) =>
a -> Text -> m Text
elementGetMetadata a
element Text
key = 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 Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    Ptr CChar
key' <- Text -> IO (Ptr CChar)
textToCString Text
key
    Ptr CChar
result <- Ptr Element -> Ptr CChar -> IO (Ptr CChar)
gst_element_get_metadata Ptr Element
element' Ptr CChar
key'
    Text -> Ptr CChar -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"elementGetMetadata" Ptr CChar
result
    Text
result' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
element
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
key'
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data ElementGetMetadataMethodInfo
instance (signature ~ (T.Text -> m T.Text), MonadIO m, IsElement a) => O.OverloadedMethod ElementGetMetadataMethodInfo a signature where
    overloadedMethod = elementGetMetadata

instance O.OverloadedMethodInfo ElementGetMetadataMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementGetMetadata",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementGetMetadata"
        })


#endif

-- method Element::get_pad_template
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstElement to get the pad template of."
--                 , 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 #GstPadTemplate to get."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "PadTemplate" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_element_get_pad_template" gst_element_get_pad_template :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    CString ->                              -- name : TBasicType TUTF8
    IO (Ptr Gst.PadTemplate.PadTemplate)

-- | Retrieves a padtemplate from /@element@/ with the given name.
-- 
-- /Since: 1.14/
elementGetPadTemplate ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element' to get the pad template of.
    -> T.Text
    -- ^ /@name@/: the name of the t'GI.Gst.Objects.PadTemplate.PadTemplate' to get.
    -> m (Maybe Gst.PadTemplate.PadTemplate)
    -- ^ __Returns:__ the t'GI.Gst.Objects.PadTemplate.PadTemplate' with the
    --     given name, or 'P.Nothing' if none was found. No unreferencing is
    --     necessary.
elementGetPadTemplate :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsElement a) =>
a -> Text -> m (Maybe PadTemplate)
elementGetPadTemplate a
element Text
name = IO (Maybe PadTemplate) -> m (Maybe PadTemplate)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe PadTemplate) -> m (Maybe PadTemplate))
-> IO (Maybe PadTemplate) -> m (Maybe PadTemplate)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    Ptr CChar
name' <- Text -> IO (Ptr CChar)
textToCString Text
name
    Ptr PadTemplate
result <- Ptr Element -> Ptr CChar -> IO (Ptr PadTemplate)
gst_element_get_pad_template Ptr Element
element' Ptr CChar
name'
    Maybe PadTemplate
maybeResult <- Ptr PadTemplate
-> (Ptr PadTemplate -> IO PadTemplate) -> IO (Maybe PadTemplate)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr PadTemplate
result ((Ptr PadTemplate -> IO PadTemplate) -> IO (Maybe PadTemplate))
-> (Ptr PadTemplate -> IO PadTemplate) -> IO (Maybe PadTemplate)
forall a b. (a -> b) -> a -> b
$ \Ptr PadTemplate
result' -> do
        PadTemplate
result'' <- ((ManagedPtr PadTemplate -> PadTemplate)
-> Ptr PadTemplate -> IO PadTemplate
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr PadTemplate -> PadTemplate
Gst.PadTemplate.PadTemplate) Ptr PadTemplate
result'
        PadTemplate -> IO PadTemplate
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PadTemplate
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
element
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
name'
    Maybe PadTemplate -> IO (Maybe PadTemplate)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe PadTemplate
maybeResult

#if defined(ENABLE_OVERLOADING)
data ElementGetPadTemplateMethodInfo
instance (signature ~ (T.Text -> m (Maybe Gst.PadTemplate.PadTemplate)), MonadIO m, IsElement a) => O.OverloadedMethod ElementGetPadTemplateMethodInfo a signature where
    overloadedMethod = elementGetPadTemplate

instance O.OverloadedMethodInfo ElementGetPadTemplateMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementGetPadTemplate",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementGetPadTemplate"
        })


#endif

-- method Element::get_pad_template_list
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstElement to get pad templates of."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList
--                  (TInterface Name { namespace = "Gst" , name = "PadTemplate" }))
-- throws : False
-- Skip return : False

foreign import ccall "gst_element_get_pad_template_list" gst_element_get_pad_template_list :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    IO (Ptr (GList (Ptr Gst.PadTemplate.PadTemplate)))

-- | Retrieves a list of the pad templates associated with /@element@/. The
-- list must not be modified by the calling code.
-- 
-- /Since: 1.14/
elementGetPadTemplateList ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element' to get pad templates of.
    -> m [Gst.PadTemplate.PadTemplate]
    -- ^ __Returns:__ the t'GI.GLib.Structs.List.List' of
    --     pad templates.
elementGetPadTemplateList :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsElement a) =>
a -> m [PadTemplate]
elementGetPadTemplateList a
element = IO [PadTemplate] -> m [PadTemplate]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [PadTemplate] -> m [PadTemplate])
-> IO [PadTemplate] -> m [PadTemplate]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    Ptr (GList (Ptr PadTemplate))
result <- Ptr Element -> IO (Ptr (GList (Ptr PadTemplate)))
gst_element_get_pad_template_list Ptr Element
element'
    [Ptr PadTemplate]
result' <- Ptr (GList (Ptr PadTemplate)) -> IO [Ptr PadTemplate]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr PadTemplate))
result
    [PadTemplate]
result'' <- (Ptr PadTemplate -> IO PadTemplate)
-> [Ptr PadTemplate] -> IO [PadTemplate]
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 PadTemplate -> PadTemplate)
-> Ptr PadTemplate -> IO PadTemplate
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr PadTemplate -> PadTemplate
Gst.PadTemplate.PadTemplate) [Ptr PadTemplate]
result'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
element
    [PadTemplate] -> IO [PadTemplate]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [PadTemplate]
result''

#if defined(ENABLE_OVERLOADING)
data ElementGetPadTemplateListMethodInfo
instance (signature ~ (m [Gst.PadTemplate.PadTemplate]), MonadIO m, IsElement a) => O.OverloadedMethod ElementGetPadTemplateListMethodInfo a signature where
    overloadedMethod = elementGetPadTemplateList

instance O.OverloadedMethodInfo ElementGetPadTemplateListMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementGetPadTemplateList",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementGetPadTemplateList"
        })


#endif

-- method Element::get_request_pad
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstElement to find a request pad of."
--                 , 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 request #GstPad to retrieve."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Pad" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_element_get_request_pad" gst_element_get_request_pad :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    CString ->                              -- name : TBasicType TUTF8
    IO (Ptr Gst.Pad.Pad)

{-# DEPRECATED elementGetRequestPad ["(Since version 1.20)","Prefer using 'GI.Gst.Objects.Element.elementRequestPadSimple' which","provides the exact same functionality."] #-}
-- | The name of this function is confusing to people learning GStreamer.
-- 'GI.Gst.Objects.Element.elementRequestPadSimple' aims at making it more explicit it is
-- a simplified 'GI.Gst.Objects.Element.elementRequestPad'.
elementGetRequestPad ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element' to find a request pad of.
    -> T.Text
    -- ^ /@name@/: the name of the request t'GI.Gst.Objects.Pad.Pad' to retrieve.
    -> m (Maybe Gst.Pad.Pad)
    -- ^ __Returns:__ requested t'GI.Gst.Objects.Pad.Pad' if found,
    --     otherwise 'P.Nothing'.  Release after usage.
elementGetRequestPad :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsElement a) =>
a -> Text -> m (Maybe Pad)
elementGetRequestPad a
element Text
name = IO (Maybe Pad) -> m (Maybe Pad)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Pad) -> m (Maybe Pad))
-> IO (Maybe Pad) -> m (Maybe Pad)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    Ptr CChar
name' <- Text -> IO (Ptr CChar)
textToCString Text
name
    Ptr Pad
result <- Ptr Element -> Ptr CChar -> IO (Ptr Pad)
gst_element_get_request_pad Ptr Element
element' Ptr CChar
name'
    Maybe Pad
maybeResult <- Ptr Pad -> (Ptr Pad -> IO Pad) -> IO (Maybe Pad)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Pad
result ((Ptr Pad -> IO Pad) -> IO (Maybe Pad))
-> (Ptr Pad -> IO Pad) -> IO (Maybe Pad)
forall a b. (a -> b) -> a -> b
$ \Ptr Pad
result' -> do
        Pad
result'' <- ((ManagedPtr Pad -> Pad) -> Ptr Pad -> IO Pad
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Pad -> Pad
Gst.Pad.Pad) Ptr Pad
result'
        Pad -> IO Pad
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Pad
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
element
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
name'
    Maybe Pad -> IO (Maybe Pad)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Pad
maybeResult

#if defined(ENABLE_OVERLOADING)
data ElementGetRequestPadMethodInfo
instance (signature ~ (T.Text -> m (Maybe Gst.Pad.Pad)), MonadIO m, IsElement a) => O.OverloadedMethod ElementGetRequestPadMethodInfo a signature where
    overloadedMethod = elementGetRequestPad

instance O.OverloadedMethodInfo ElementGetRequestPadMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementGetRequestPad",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementGetRequestPad"
        })


#endif

-- method Element::get_start_time
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstElement." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt64)
-- throws : False
-- Skip return : False

foreign import ccall "gst_element_get_start_time" gst_element_get_start_time :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    IO Word64

-- | Returns the start time of the element. The start time is the
-- running time of the clock when this element was last put to PAUSED.
-- 
-- Usually the start_time is managed by a toplevel element such as
-- t'GI.Gst.Objects.Pipeline.Pipeline'.
-- 
-- MT safe.
elementGetStartTime ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element'.
    -> m Word64
    -- ^ __Returns:__ the start time of the element.
elementGetStartTime :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsElement a) =>
a -> m Word64
elementGetStartTime a
element = IO Word64 -> m Word64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
    Ptr Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    Word64
result <- Ptr Element -> IO Word64
gst_element_get_start_time Ptr Element
element'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
element
    Word64 -> IO Word64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data ElementGetStartTimeMethodInfo
instance (signature ~ (m Word64), MonadIO m, IsElement a) => O.OverloadedMethod ElementGetStartTimeMethodInfo a signature where
    overloadedMethod = elementGetStartTime

instance O.OverloadedMethodInfo ElementGetStartTimeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementGetStartTime",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementGetStartTime"
        })


#endif

-- method Element::get_state
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstElement to get the state of."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "state"
--           , argType = TInterface Name { namespace = "Gst" , name = "State" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a pointer to #GstState to hold the state.\n    Can be %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "pending"
--           , argType = TInterface Name { namespace = "Gst" , name = "State" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a pointer to #GstState to hold the pending\n    state. Can be %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "timeout"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a #GstClockTime to specify the timeout for an async\n          state change or %GST_CLOCK_TIME_NONE for infinite timeout."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Gst" , name = "StateChangeReturn" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_element_get_state" gst_element_get_state :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    Ptr CUInt ->                            -- state : TInterface (Name {namespace = "Gst", name = "State"})
    Ptr CUInt ->                            -- pending : TInterface (Name {namespace = "Gst", name = "State"})
    Word64 ->                               -- timeout : TBasicType TUInt64
    IO CUInt

-- | Gets the state of the element.
-- 
-- For elements that performed an ASYNC state change, as reported by
-- 'GI.Gst.Objects.Element.elementSetState', this function will block up to the
-- specified timeout value for the state change to complete.
-- If the element completes the state change or goes into
-- an error, this function returns immediately with a return value of
-- 'GI.Gst.Enums.StateChangeReturnSuccess' or 'GI.Gst.Enums.StateChangeReturnFailure' respectively.
-- 
-- For elements that did not return 'GI.Gst.Enums.StateChangeReturnAsync', this function
-- returns the current and pending state immediately.
-- 
-- This function returns 'GI.Gst.Enums.StateChangeReturnNoPreroll' if the element
-- successfully changed its state but is not able to provide data yet.
-- This mostly happens for live sources that only produce data in
-- 'GI.Gst.Enums.StatePlaying'. While the state change return is equivalent to
-- 'GI.Gst.Enums.StateChangeReturnSuccess', it is returned to the application to signal that
-- some sink elements might not be able to complete their state change because
-- an element is not producing data to complete the preroll. When setting the
-- element to playing, the preroll will complete and playback will start.
elementGetState ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element' to get the state of.
    -> Word64
    -- ^ /@timeout@/: a @/GstClockTime/@ to specify the timeout for an async
    --           state change or 'GI.Gst.Constants.CLOCK_TIME_NONE' for infinite timeout.
    -> m ((Gst.Enums.StateChangeReturn, Gst.Enums.State, Gst.Enums.State))
    -- ^ __Returns:__ 'GI.Gst.Enums.StateChangeReturnSuccess' if the element has no more pending state
    --          and the last state change succeeded, 'GI.Gst.Enums.StateChangeReturnAsync' if the
    --          element is still performing a state change or
    --          'GI.Gst.Enums.StateChangeReturnFailure' if the last state change failed.
    -- 
    -- MT safe.
elementGetState :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsElement a) =>
a -> Word64 -> m (StateChangeReturn, State, State)
elementGetState a
element Word64
timeout = IO (StateChangeReturn, State, State)
-> m (StateChangeReturn, State, State)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (StateChangeReturn, State, State)
 -> m (StateChangeReturn, State, State))
-> IO (StateChangeReturn, State, State)
-> m (StateChangeReturn, State, State)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    Ptr CUInt
state <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
    Ptr CUInt
pending <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
    CUInt
result <- Ptr Element -> Ptr CUInt -> Ptr CUInt -> Word64 -> IO CUInt
gst_element_get_state Ptr Element
element' Ptr CUInt
state Ptr CUInt
pending Word64
timeout
    let result' :: StateChangeReturn
result' = (Int -> StateChangeReturn
forall a. Enum a => Int -> a
toEnum (Int -> StateChangeReturn)
-> (CUInt -> Int) -> CUInt -> StateChangeReturn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    CUInt
state' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
state
    let state'' :: State
state'' = (Int -> State
forall a. Enum a => Int -> a
toEnum (Int -> State) -> (CUInt -> Int) -> CUInt -> State
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
state'
    CUInt
pending' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
pending
    let pending'' :: State
pending'' = (Int -> State
forall a. Enum a => Int -> a
toEnum (Int -> State) -> (CUInt -> Int) -> CUInt -> State
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
pending'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
element
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
state
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
pending
    (StateChangeReturn, State, State)
-> IO (StateChangeReturn, State, State)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (StateChangeReturn
result', State
state'', State
pending'')

#if defined(ENABLE_OVERLOADING)
data ElementGetStateMethodInfo
instance (signature ~ (Word64 -> m ((Gst.Enums.StateChangeReturn, Gst.Enums.State, Gst.Enums.State))), MonadIO m, IsElement a) => O.OverloadedMethod ElementGetStateMethodInfo a signature where
    overloadedMethod = elementGetState

instance O.OverloadedMethodInfo ElementGetStateMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementGetState",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementGetState"
        })


#endif

-- method Element::get_static_pad
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstElement to find a static pad of."
--                 , 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 static #GstPad to retrieve."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Pad" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_element_get_static_pad" gst_element_get_static_pad :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    CString ->                              -- name : TBasicType TUTF8
    IO (Ptr Gst.Pad.Pad)

-- | Retrieves a pad from /@element@/ by name. This version only retrieves
-- already-existing (i.e. \'static\') pads.
elementGetStaticPad ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element' to find a static pad of.
    -> T.Text
    -- ^ /@name@/: the name of the static t'GI.Gst.Objects.Pad.Pad' to retrieve.
    -> m (Maybe Gst.Pad.Pad)
    -- ^ __Returns:__ the requested t'GI.Gst.Objects.Pad.Pad' if
    --     found, otherwise 'P.Nothing'.  unref after usage.
    -- 
    -- MT safe.
elementGetStaticPad :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsElement a) =>
a -> Text -> m (Maybe Pad)
elementGetStaticPad a
element Text
name = IO (Maybe Pad) -> m (Maybe Pad)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Pad) -> m (Maybe Pad))
-> IO (Maybe Pad) -> m (Maybe Pad)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    Ptr CChar
name' <- Text -> IO (Ptr CChar)
textToCString Text
name
    Ptr Pad
result <- Ptr Element -> Ptr CChar -> IO (Ptr Pad)
gst_element_get_static_pad Ptr Element
element' Ptr CChar
name'
    Maybe Pad
maybeResult <- Ptr Pad -> (Ptr Pad -> IO Pad) -> IO (Maybe Pad)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Pad
result ((Ptr Pad -> IO Pad) -> IO (Maybe Pad))
-> (Ptr Pad -> IO Pad) -> IO (Maybe Pad)
forall a b. (a -> b) -> a -> b
$ \Ptr Pad
result' -> do
        Pad
result'' <- ((ManagedPtr Pad -> Pad) -> Ptr Pad -> IO Pad
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Pad -> Pad
Gst.Pad.Pad) Ptr Pad
result'
        Pad -> IO Pad
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Pad
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
element
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
name'
    Maybe Pad -> IO (Maybe Pad)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Pad
maybeResult

#if defined(ENABLE_OVERLOADING)
data ElementGetStaticPadMethodInfo
instance (signature ~ (T.Text -> m (Maybe Gst.Pad.Pad)), MonadIO m, IsElement a) => O.OverloadedMethod ElementGetStaticPadMethodInfo a signature where
    overloadedMethod = elementGetStaticPad

instance O.OverloadedMethodInfo ElementGetStaticPadMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementGetStaticPad",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementGetStaticPad"
        })


#endif

-- method Element::is_locked_state
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstElement." , 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_element_is_locked_state" gst_element_is_locked_state :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    IO CInt

-- | Checks if the state of an element is locked.
-- If the state of an element is locked, state changes of the parent don\'t
-- affect the element.
-- This way you can leave currently unused elements inside bins. Just lock their
-- state before changing the state from @/GST_STATE_NULL/@.
-- 
-- MT safe.
elementIsLockedState ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element'.
    -> m Bool
    -- ^ __Returns:__ 'P.True', if the element\'s state is locked.
elementIsLockedState :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsElement a) =>
a -> m Bool
elementIsLockedState a
element = 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 Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    CInt
result <- Ptr Element -> IO CInt
gst_element_is_locked_state Ptr Element
element'
    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
element
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ElementIsLockedStateMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsElement a) => O.OverloadedMethod ElementIsLockedStateMethodInfo a signature where
    overloadedMethod = elementIsLockedState

instance O.OverloadedMethodInfo ElementIsLockedStateMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementIsLockedState",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementIsLockedState"
        })


#endif

-- method Element::iterate_pads
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstElement to iterate pads of."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Iterator" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_element_iterate_pads" gst_element_iterate_pads :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    IO (Ptr Gst.Iterator.Iterator)

-- | Retrieves an iterator of /@element@/\'s pads. The iterator should
-- be freed after usage. Also more specialized iterators exists such as
-- 'GI.Gst.Objects.Element.elementIterateSrcPads' or 'GI.Gst.Objects.Element.elementIterateSinkPads'.
-- 
-- The order of pads returned by the iterator will be the order in which
-- the pads were added to the element.
elementIteratePads ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element' to iterate pads of.
    -> m Gst.Iterator.Iterator
    -- ^ __Returns:__ the t'GI.Gst.Structs.Iterator.Iterator' of t'GI.Gst.Objects.Pad.Pad'.
    -- 
    -- MT safe.
elementIteratePads :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsElement a) =>
a -> m Iterator
elementIteratePads a
element = IO Iterator -> m Iterator
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Iterator -> m Iterator) -> IO Iterator -> m Iterator
forall a b. (a -> b) -> a -> b
$ do
    Ptr Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    Ptr Iterator
result <- Ptr Element -> IO (Ptr Iterator)
gst_element_iterate_pads Ptr Element
element'
    Text -> Ptr Iterator -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"elementIteratePads" Ptr Iterator
result
    Iterator
result' <- ((ManagedPtr Iterator -> Iterator) -> Ptr Iterator -> IO Iterator
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Iterator -> Iterator
Gst.Iterator.Iterator) Ptr Iterator
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
element
    Iterator -> IO Iterator
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Iterator
result'

#if defined(ENABLE_OVERLOADING)
data ElementIteratePadsMethodInfo
instance (signature ~ (m Gst.Iterator.Iterator), MonadIO m, IsElement a) => O.OverloadedMethod ElementIteratePadsMethodInfo a signature where
    overloadedMethod = elementIteratePads

instance O.OverloadedMethodInfo ElementIteratePadsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementIteratePads",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementIteratePads"
        })


#endif

-- method Element::iterate_sink_pads
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstElement." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Iterator" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_element_iterate_sink_pads" gst_element_iterate_sink_pads :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    IO (Ptr Gst.Iterator.Iterator)

-- | Retrieves an iterator of /@element@/\'s sink pads.
-- 
-- The order of pads returned by the iterator will be the order in which
-- the pads were added to the element.
elementIterateSinkPads ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element'.
    -> m Gst.Iterator.Iterator
    -- ^ __Returns:__ the t'GI.Gst.Structs.Iterator.Iterator' of t'GI.Gst.Objects.Pad.Pad'.
    -- 
    -- MT safe.
elementIterateSinkPads :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsElement a) =>
a -> m Iterator
elementIterateSinkPads a
element = IO Iterator -> m Iterator
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Iterator -> m Iterator) -> IO Iterator -> m Iterator
forall a b. (a -> b) -> a -> b
$ do
    Ptr Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    Ptr Iterator
result <- Ptr Element -> IO (Ptr Iterator)
gst_element_iterate_sink_pads Ptr Element
element'
    Text -> Ptr Iterator -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"elementIterateSinkPads" Ptr Iterator
result
    Iterator
result' <- ((ManagedPtr Iterator -> Iterator) -> Ptr Iterator -> IO Iterator
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Iterator -> Iterator
Gst.Iterator.Iterator) Ptr Iterator
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
element
    Iterator -> IO Iterator
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Iterator
result'

#if defined(ENABLE_OVERLOADING)
data ElementIterateSinkPadsMethodInfo
instance (signature ~ (m Gst.Iterator.Iterator), MonadIO m, IsElement a) => O.OverloadedMethod ElementIterateSinkPadsMethodInfo a signature where
    overloadedMethod = elementIterateSinkPads

instance O.OverloadedMethodInfo ElementIterateSinkPadsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementIterateSinkPads",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementIterateSinkPads"
        })


#endif

-- method Element::iterate_src_pads
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstElement." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Iterator" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_element_iterate_src_pads" gst_element_iterate_src_pads :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    IO (Ptr Gst.Iterator.Iterator)

-- | Retrieves an iterator of /@element@/\'s source pads.
-- 
-- The order of pads returned by the iterator will be the order in which
-- the pads were added to the element.
elementIterateSrcPads ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element'.
    -> m Gst.Iterator.Iterator
    -- ^ __Returns:__ the t'GI.Gst.Structs.Iterator.Iterator' of t'GI.Gst.Objects.Pad.Pad'.
    -- 
    -- MT safe.
elementIterateSrcPads :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsElement a) =>
a -> m Iterator
elementIterateSrcPads a
element = IO Iterator -> m Iterator
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Iterator -> m Iterator) -> IO Iterator -> m Iterator
forall a b. (a -> b) -> a -> b
$ do
    Ptr Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    Ptr Iterator
result <- Ptr Element -> IO (Ptr Iterator)
gst_element_iterate_src_pads Ptr Element
element'
    Text -> Ptr Iterator -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"elementIterateSrcPads" Ptr Iterator
result
    Iterator
result' <- ((ManagedPtr Iterator -> Iterator) -> Ptr Iterator -> IO Iterator
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Iterator -> Iterator
Gst.Iterator.Iterator) Ptr Iterator
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
element
    Iterator -> IO Iterator
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Iterator
result'

#if defined(ENABLE_OVERLOADING)
data ElementIterateSrcPadsMethodInfo
instance (signature ~ (m Gst.Iterator.Iterator), MonadIO m, IsElement a) => O.OverloadedMethod ElementIterateSrcPadsMethodInfo a signature where
    overloadedMethod = elementIterateSrcPads

instance O.OverloadedMethodInfo ElementIterateSrcPadsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementIterateSrcPads",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementIterateSrcPads"
        })


#endif

-- method Element::link
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "src"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstElement containing the source pad."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dest"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the #GstElement containing the destination pad."
--                 , 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_element_link" gst_element_link :: 
    Ptr Element ->                          -- src : TInterface (Name {namespace = "Gst", name = "Element"})
    Ptr Element ->                          -- dest : TInterface (Name {namespace = "Gst", name = "Element"})
    IO CInt

-- | Links /@src@/ to /@dest@/. The link must be from source to
-- destination; the other direction will not be tried. The function looks for
-- existing pads that aren\'t linked yet. It will request new pads if necessary.
-- Such pads need to be released manually when unlinking.
-- If multiple links are possible, only one is established.
-- 
-- Make sure you have added your elements to a bin or pipeline with
-- 'GI.Gst.Objects.Bin.binAdd' before trying to link them.
elementLink ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a, IsElement b) =>
    a
    -- ^ /@src@/: a t'GI.Gst.Objects.Element.Element' containing the source pad.
    -> b
    -- ^ /@dest@/: the t'GI.Gst.Objects.Element.Element' containing the destination pad.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the elements could be linked, 'P.False' otherwise.
elementLink :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsElement a, IsElement b) =>
a -> b -> m Bool
elementLink a
src b
dest = 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 Element
src' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
src
    Ptr Element
dest' <- b -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
dest
    CInt
result <- Ptr Element -> Ptr Element -> IO CInt
gst_element_link Ptr Element
src' Ptr Element
dest'
    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
src
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
dest
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ElementLinkMethodInfo
instance (signature ~ (b -> m Bool), MonadIO m, IsElement a, IsElement b) => O.OverloadedMethod ElementLinkMethodInfo a signature where
    overloadedMethod = elementLink

instance O.OverloadedMethodInfo ElementLinkMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementLink",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementLink"
        })


#endif

-- method Element::link_filtered
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "src"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstElement containing the source pad."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dest"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the #GstElement containing the destination pad."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "filter"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the #GstCaps to filter the link,\n    or %NULL for no filter."
--                 , 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_element_link_filtered" gst_element_link_filtered :: 
    Ptr Element ->                          -- src : TInterface (Name {namespace = "Gst", name = "Element"})
    Ptr Element ->                          -- dest : TInterface (Name {namespace = "Gst", name = "Element"})
    Ptr Gst.Caps.Caps ->                    -- filter : TInterface (Name {namespace = "Gst", name = "Caps"})
    IO CInt

-- | Links /@src@/ to /@dest@/ using the given caps as filtercaps.
-- The link must be from source to
-- destination; the other direction will not be tried. The function looks for
-- existing pads that aren\'t linked yet. It will request new pads if necessary.
-- If multiple links are possible, only one is established.
-- 
-- Make sure you have added your elements to a bin or pipeline with
-- 'GI.Gst.Objects.Bin.binAdd' before trying to link them.
elementLinkFiltered ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a, IsElement b) =>
    a
    -- ^ /@src@/: a t'GI.Gst.Objects.Element.Element' containing the source pad.
    -> b
    -- ^ /@dest@/: the t'GI.Gst.Objects.Element.Element' containing the destination pad.
    -> Maybe (Gst.Caps.Caps)
    -- ^ /@filter@/: the t'GI.Gst.Structs.Caps.Caps' to filter the link,
    --     or 'P.Nothing' for no filter.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the pads could be linked, 'P.False' otherwise.
elementLinkFiltered :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsElement a, IsElement b) =>
a -> b -> Maybe Caps -> m Bool
elementLinkFiltered a
src b
dest Maybe Caps
filter = 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 Element
src' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
src
    Ptr Element
dest' <- b -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
dest
    Ptr Caps
maybeFilter <- case Maybe Caps
filter of
        Maybe Caps
Nothing -> Ptr Caps -> IO (Ptr Caps)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Caps
forall a. Ptr a
nullPtr
        Just Caps
jFilter -> do
            Ptr Caps
jFilter' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
jFilter
            Ptr Caps -> IO (Ptr Caps)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Caps
jFilter'
    CInt
result <- Ptr Element -> Ptr Element -> Ptr Caps -> IO CInt
gst_element_link_filtered Ptr Element
src' Ptr Element
dest' Ptr Caps
maybeFilter
    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
src
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
dest
    Maybe Caps -> (Caps -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Caps
filter Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ElementLinkFilteredMethodInfo
instance (signature ~ (b -> Maybe (Gst.Caps.Caps) -> m Bool), MonadIO m, IsElement a, IsElement b) => O.OverloadedMethod ElementLinkFilteredMethodInfo a signature where
    overloadedMethod = elementLinkFiltered

instance O.OverloadedMethodInfo ElementLinkFilteredMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementLinkFiltered",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementLinkFiltered"
        })


#endif

-- method Element::link_pads
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "src"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstElement containing the source pad."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "srcpadname"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the name of the #GstPad in source element\n    or %NULL for any pad."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dest"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the #GstElement containing the destination pad."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "destpadname"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the name of the #GstPad in destination element,\nor %NULL for any pad."
--                 , 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_element_link_pads" gst_element_link_pads :: 
    Ptr Element ->                          -- src : TInterface (Name {namespace = "Gst", name = "Element"})
    CString ->                              -- srcpadname : TBasicType TUTF8
    Ptr Element ->                          -- dest : TInterface (Name {namespace = "Gst", name = "Element"})
    CString ->                              -- destpadname : TBasicType TUTF8
    IO CInt

-- | Links the two named pads of the source and destination elements.
-- Side effect is that if one of the pads has no parent, it becomes a
-- child of the parent of the other element.  If they have different
-- parents, the link fails.
elementLinkPads ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a, IsElement b) =>
    a
    -- ^ /@src@/: a t'GI.Gst.Objects.Element.Element' containing the source pad.
    -> Maybe (T.Text)
    -- ^ /@srcpadname@/: the name of the t'GI.Gst.Objects.Pad.Pad' in source element
    --     or 'P.Nothing' for any pad.
    -> b
    -- ^ /@dest@/: the t'GI.Gst.Objects.Element.Element' containing the destination pad.
    -> Maybe (T.Text)
    -- ^ /@destpadname@/: the name of the t'GI.Gst.Objects.Pad.Pad' in destination element,
    -- or 'P.Nothing' for any pad.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the pads could be linked, 'P.False' otherwise.
elementLinkPads :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsElement a, IsElement b) =>
a -> Maybe Text -> b -> Maybe Text -> m Bool
elementLinkPads a
src Maybe Text
srcpadname b
dest Maybe Text
destpadname = 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 Element
src' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
src
    Ptr CChar
maybeSrcpadname <- case Maybe Text
srcpadname of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jSrcpadname -> do
            Ptr CChar
jSrcpadname' <- Text -> IO (Ptr CChar)
textToCString Text
jSrcpadname
            Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jSrcpadname'
    Ptr Element
dest' <- b -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
dest
    Ptr CChar
maybeDestpadname <- case Maybe Text
destpadname of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jDestpadname -> do
            Ptr CChar
jDestpadname' <- Text -> IO (Ptr CChar)
textToCString Text
jDestpadname
            Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jDestpadname'
    CInt
result <- Ptr Element -> Ptr CChar -> Ptr Element -> Ptr CChar -> IO CInt
gst_element_link_pads Ptr Element
src' Ptr CChar
maybeSrcpadname Ptr Element
dest' Ptr CChar
maybeDestpadname
    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
src
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
dest
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeSrcpadname
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeDestpadname
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ElementLinkPadsMethodInfo
instance (signature ~ (Maybe (T.Text) -> b -> Maybe (T.Text) -> m Bool), MonadIO m, IsElement a, IsElement b) => O.OverloadedMethod ElementLinkPadsMethodInfo a signature where
    overloadedMethod = elementLinkPads

instance O.OverloadedMethodInfo ElementLinkPadsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementLinkPads",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementLinkPads"
        })


#endif

-- method Element::link_pads_filtered
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "src"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstElement containing the source pad."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "srcpadname"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the name of the #GstPad in source element\n    or %NULL for any pad."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dest"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the #GstElement containing the destination pad."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "destpadname"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the name of the #GstPad in destination element\n    or %NULL for any pad."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "filter"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the #GstCaps to filter the link,\n    or %NULL for no filter."
--                 , 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_element_link_pads_filtered" gst_element_link_pads_filtered :: 
    Ptr Element ->                          -- src : TInterface (Name {namespace = "Gst", name = "Element"})
    CString ->                              -- srcpadname : TBasicType TUTF8
    Ptr Element ->                          -- dest : TInterface (Name {namespace = "Gst", name = "Element"})
    CString ->                              -- destpadname : TBasicType TUTF8
    Ptr Gst.Caps.Caps ->                    -- filter : TInterface (Name {namespace = "Gst", name = "Caps"})
    IO CInt

-- | Links the two named pads of the source and destination elements. Side effect
-- is that if one of the pads has no parent, it becomes a child of the parent of
-- the other element. If they have different parents, the link fails. If /@caps@/
-- is not 'P.Nothing', makes sure that the caps of the link is a subset of /@caps@/.
elementLinkPadsFiltered ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a, IsElement b) =>
    a
    -- ^ /@src@/: a t'GI.Gst.Objects.Element.Element' containing the source pad.
    -> Maybe (T.Text)
    -- ^ /@srcpadname@/: the name of the t'GI.Gst.Objects.Pad.Pad' in source element
    --     or 'P.Nothing' for any pad.
    -> b
    -- ^ /@dest@/: the t'GI.Gst.Objects.Element.Element' containing the destination pad.
    -> Maybe (T.Text)
    -- ^ /@destpadname@/: the name of the t'GI.Gst.Objects.Pad.Pad' in destination element
    --     or 'P.Nothing' for any pad.
    -> Maybe (Gst.Caps.Caps)
    -- ^ /@filter@/: the t'GI.Gst.Structs.Caps.Caps' to filter the link,
    --     or 'P.Nothing' for no filter.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the pads could be linked, 'P.False' otherwise.
elementLinkPadsFiltered :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsElement a, IsElement b) =>
a -> Maybe Text -> b -> Maybe Text -> Maybe Caps -> m Bool
elementLinkPadsFiltered a
src Maybe Text
srcpadname b
dest Maybe Text
destpadname Maybe Caps
filter = 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 Element
src' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
src
    Ptr CChar
maybeSrcpadname <- case Maybe Text
srcpadname of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jSrcpadname -> do
            Ptr CChar
jSrcpadname' <- Text -> IO (Ptr CChar)
textToCString Text
jSrcpadname
            Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jSrcpadname'
    Ptr Element
dest' <- b -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
dest
    Ptr CChar
maybeDestpadname <- case Maybe Text
destpadname of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jDestpadname -> do
            Ptr CChar
jDestpadname' <- Text -> IO (Ptr CChar)
textToCString Text
jDestpadname
            Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jDestpadname'
    Ptr Caps
maybeFilter <- case Maybe Caps
filter of
        Maybe Caps
Nothing -> Ptr Caps -> IO (Ptr Caps)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Caps
forall a. Ptr a
nullPtr
        Just Caps
jFilter -> do
            Ptr Caps
jFilter' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
jFilter
            Ptr Caps -> IO (Ptr Caps)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Caps
jFilter'
    CInt
result <- Ptr Element
-> Ptr CChar -> Ptr Element -> Ptr CChar -> Ptr Caps -> IO CInt
gst_element_link_pads_filtered Ptr Element
src' Ptr CChar
maybeSrcpadname Ptr Element
dest' Ptr CChar
maybeDestpadname Ptr Caps
maybeFilter
    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
src
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
dest
    Maybe Caps -> (Caps -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Caps
filter Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeSrcpadname
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeDestpadname
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ElementLinkPadsFilteredMethodInfo
instance (signature ~ (Maybe (T.Text) -> b -> Maybe (T.Text) -> Maybe (Gst.Caps.Caps) -> m Bool), MonadIO m, IsElement a, IsElement b) => O.OverloadedMethod ElementLinkPadsFilteredMethodInfo a signature where
    overloadedMethod = elementLinkPadsFiltered

instance O.OverloadedMethodInfo ElementLinkPadsFilteredMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementLinkPadsFiltered",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementLinkPadsFiltered"
        })


#endif

-- method Element::link_pads_full
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "src"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstElement containing the source pad."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "srcpadname"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the name of the #GstPad in source element\n    or %NULL for any pad."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dest"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the #GstElement containing the destination pad."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "destpadname"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the name of the #GstPad in destination element,\nor %NULL for any pad."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "PadLinkCheck" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the #GstPadLinkCheck to be performed when linking pads."
--                 , 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_element_link_pads_full" gst_element_link_pads_full :: 
    Ptr Element ->                          -- src : TInterface (Name {namespace = "Gst", name = "Element"})
    CString ->                              -- srcpadname : TBasicType TUTF8
    Ptr Element ->                          -- dest : TInterface (Name {namespace = "Gst", name = "Element"})
    CString ->                              -- destpadname : TBasicType TUTF8
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gst", name = "PadLinkCheck"})
    IO CInt

-- | Links the two named pads of the source and destination elements.
-- Side effect is that if one of the pads has no parent, it becomes a
-- child of the parent of the other element.  If they have different
-- parents, the link fails.
-- 
-- Calling 'GI.Gst.Objects.Element.elementLinkPadsFull' with /@flags@/ == 'GI.Gst.Flags.PadLinkCheckDefault'
-- is the same as calling 'GI.Gst.Objects.Element.elementLinkPads' and the recommended way of
-- linking pads with safety checks applied.
-- 
-- This is a convenience function for 'GI.Gst.Objects.Pad.padLinkFull'.
elementLinkPadsFull ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a, IsElement b) =>
    a
    -- ^ /@src@/: a t'GI.Gst.Objects.Element.Element' containing the source pad.
    -> Maybe (T.Text)
    -- ^ /@srcpadname@/: the name of the t'GI.Gst.Objects.Pad.Pad' in source element
    --     or 'P.Nothing' for any pad.
    -> b
    -- ^ /@dest@/: the t'GI.Gst.Objects.Element.Element' containing the destination pad.
    -> Maybe (T.Text)
    -- ^ /@destpadname@/: the name of the t'GI.Gst.Objects.Pad.Pad' in destination element,
    -- or 'P.Nothing' for any pad.
    -> [Gst.Flags.PadLinkCheck]
    -- ^ /@flags@/: the t'GI.Gst.Flags.PadLinkCheck' to be performed when linking pads.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the pads could be linked, 'P.False' otherwise.
elementLinkPadsFull :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsElement a, IsElement b) =>
a -> Maybe Text -> b -> Maybe Text -> [PadLinkCheck] -> m Bool
elementLinkPadsFull a
src Maybe Text
srcpadname b
dest Maybe Text
destpadname [PadLinkCheck]
flags = 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 Element
src' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
src
    Ptr CChar
maybeSrcpadname <- case Maybe Text
srcpadname of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jSrcpadname -> do
            Ptr CChar
jSrcpadname' <- Text -> IO (Ptr CChar)
textToCString Text
jSrcpadname
            Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jSrcpadname'
    Ptr Element
dest' <- b -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
dest
    Ptr CChar
maybeDestpadname <- case Maybe Text
destpadname of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jDestpadname -> do
            Ptr CChar
jDestpadname' <- Text -> IO (Ptr CChar)
textToCString Text
jDestpadname
            Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jDestpadname'
    let flags' :: CUInt
flags' = [PadLinkCheck] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [PadLinkCheck]
flags
    CInt
result <- Ptr Element
-> Ptr CChar -> Ptr Element -> Ptr CChar -> CUInt -> IO CInt
gst_element_link_pads_full Ptr Element
src' Ptr CChar
maybeSrcpadname Ptr Element
dest' Ptr CChar
maybeDestpadname CUInt
flags'
    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
src
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
dest
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeSrcpadname
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeDestpadname
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ElementLinkPadsFullMethodInfo
instance (signature ~ (Maybe (T.Text) -> b -> Maybe (T.Text) -> [Gst.Flags.PadLinkCheck] -> m Bool), MonadIO m, IsElement a, IsElement b) => O.OverloadedMethod ElementLinkPadsFullMethodInfo a signature where
    overloadedMethod = elementLinkPadsFull

instance O.OverloadedMethodInfo ElementLinkPadsFullMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementLinkPadsFull",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementLinkPadsFull"
        })


#endif

-- method Element::lost_state
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstElement the state is lost of"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_element_lost_state" gst_element_lost_state :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    IO ()

-- | Brings the element to the lost state. The current state of the
-- element is copied to the pending state so that any call to
-- 'GI.Gst.Objects.Element.elementGetState' will return 'GI.Gst.Enums.StateChangeReturnAsync'.
-- 
-- An ASYNC_START message is posted. If the element was PLAYING, it will
-- go to PAUSED. The element will be restored to its PLAYING state by
-- the parent pipeline when it prerolls again.
-- 
-- This is mostly used for elements that lost their preroll buffer
-- in the 'GI.Gst.Enums.StatePaused' or 'GI.Gst.Enums.StatePlaying' state after a flush,
-- they will go to their pending state again when a new preroll buffer is
-- queued. This function can only be called when the element is currently
-- not in error or an async state change.
-- 
-- This function is used internally and should normally not be called from
-- plugins or applications.
elementLostState ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element' the state is lost of
    -> m ()
elementLostState :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsElement a) =>
a -> m ()
elementLostState a
element = 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 Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    Ptr Element -> IO ()
gst_element_lost_state Ptr Element
element'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
element
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ElementLostStateMethodInfo
instance (signature ~ (m ()), MonadIO m, IsElement a) => O.OverloadedMethod ElementLostStateMethodInfo a signature where
    overloadedMethod = elementLostState

instance O.OverloadedMethodInfo ElementLostStateMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementLostState",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementLostState"
        })


#endif

-- method Element::message_full
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstElement to send message from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "type"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "MessageType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstMessageType"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "domain"
--           , argType = TBasicType TUInt32
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the GStreamer GError domain this message belongs to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "code"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the GError code belonging to the domain"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "text"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "an allocated text string to be used\n           as a replacement for the default message connected to code,\n           or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "debug"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "an allocated debug message to be\n           used as a replacement for the default debugging information,\n           or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "file"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the source code file where the error was generated"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "function"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the source code function where the error was generated"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "line"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the source code line where the error was generated"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_element_message_full" gst_element_message_full :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    CUInt ->                                -- type : TInterface (Name {namespace = "Gst", name = "MessageType"})
    Word32 ->                               -- domain : TBasicType TUInt32
    Int32 ->                                -- code : TBasicType TInt
    CString ->                              -- text : TBasicType TUTF8
    CString ->                              -- debug : TBasicType TUTF8
    CString ->                              -- file : TBasicType TUTF8
    CString ->                              -- function : TBasicType TUTF8
    Int32 ->                                -- line : TBasicType TInt
    IO ()

-- | Post an error, warning or info message on the bus from inside an element.
-- 
-- /@type@/ must be of @/GST_MESSAGE_ERROR/@, @/GST_MESSAGE_WARNING/@ or
-- @/GST_MESSAGE_INFO/@.
-- 
-- MT safe.
elementMessageFull ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element' to send message from
    -> [Gst.Flags.MessageType]
    -- ^ /@type@/: the t'GI.Gst.Flags.MessageType'
    -> Word32
    -- ^ /@domain@/: the GStreamer GError domain this message belongs to
    -> Int32
    -- ^ /@code@/: the GError code belonging to the domain
    -> Maybe (T.Text)
    -- ^ /@text@/: an allocated text string to be used
    --            as a replacement for the default message connected to code,
    --            or 'P.Nothing'
    -> Maybe (T.Text)
    -- ^ /@debug@/: an allocated debug message to be
    --            used as a replacement for the default debugging information,
    --            or 'P.Nothing'
    -> T.Text
    -- ^ /@file@/: the source code file where the error was generated
    -> T.Text
    -- ^ /@function@/: the source code function where the error was generated
    -> Int32
    -- ^ /@line@/: the source code line where the error was generated
    -> m ()
elementMessageFull :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsElement a) =>
a
-> [MessageType]
-> Word32
-> Int32
-> Maybe Text
-> Maybe Text
-> Text
-> Text
-> Int32
-> m ()
elementMessageFull a
element [MessageType]
type_ Word32
domain Int32
code Maybe Text
text Maybe Text
debug Text
file Text
function Int32
line = 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 Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    let type_' :: CUInt
type_' = [MessageType] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [MessageType]
type_
    Ptr CChar
maybeText <- case Maybe Text
text of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jText -> do
            Ptr CChar
jText' <- Text -> IO (Ptr CChar)
textToCString Text
jText
            Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jText'
    Ptr CChar
maybeDebug <- case Maybe Text
debug of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jDebug -> do
            Ptr CChar
jDebug' <- Text -> IO (Ptr CChar)
textToCString Text
jDebug
            Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jDebug'
    Ptr CChar
file' <- Text -> IO (Ptr CChar)
textToCString Text
file
    Ptr CChar
function' <- Text -> IO (Ptr CChar)
textToCString Text
function
    Ptr Element
-> CUInt
-> Word32
-> Int32
-> Ptr CChar
-> Ptr CChar
-> Ptr CChar
-> Ptr CChar
-> Int32
-> IO ()
gst_element_message_full Ptr Element
element' CUInt
type_' Word32
domain Int32
code Ptr CChar
maybeText Ptr CChar
maybeDebug Ptr CChar
file' Ptr CChar
function' Int32
line
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
element
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
file'
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
function'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ElementMessageFullMethodInfo
instance (signature ~ ([Gst.Flags.MessageType] -> Word32 -> Int32 -> Maybe (T.Text) -> Maybe (T.Text) -> T.Text -> T.Text -> Int32 -> m ()), MonadIO m, IsElement a) => O.OverloadedMethod ElementMessageFullMethodInfo a signature where
    overloadedMethod = elementMessageFull

instance O.OverloadedMethodInfo ElementMessageFullMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementMessageFull",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementMessageFull"
        })


#endif

-- method Element::message_full_with_details
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstElement to send message from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "type"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "MessageType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstMessageType"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "domain"
--           , argType = TBasicType TUInt32
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the GStreamer GError domain this message belongs to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "code"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the GError code belonging to the domain"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "text"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "an allocated text string to be used\n           as a replacement for the default message connected to code,\n           or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "debug"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "an allocated debug message to be\n           used as a replacement for the default debugging information,\n           or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "file"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the source code file where the error was generated"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "function"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the source code function where the error was generated"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "line"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the source code line where the error was generated"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "optional details structure"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_element_message_full_with_details" gst_element_message_full_with_details :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    CUInt ->                                -- type : TInterface (Name {namespace = "Gst", name = "MessageType"})
    Word32 ->                               -- domain : TBasicType TUInt32
    Int32 ->                                -- code : TBasicType TInt
    CString ->                              -- text : TBasicType TUTF8
    CString ->                              -- debug : TBasicType TUTF8
    CString ->                              -- file : TBasicType TUTF8
    CString ->                              -- function : TBasicType TUTF8
    Int32 ->                                -- line : TBasicType TInt
    Ptr Gst.Structure.Structure ->          -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    IO ()

-- | Post an error, warning or info message on the bus from inside an element.
-- 
-- /@type@/ must be of @/GST_MESSAGE_ERROR/@, @/GST_MESSAGE_WARNING/@ or
-- @/GST_MESSAGE_INFO/@.
-- 
-- /Since: 1.10/
elementMessageFullWithDetails ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element' to send message from
    -> [Gst.Flags.MessageType]
    -- ^ /@type@/: the t'GI.Gst.Flags.MessageType'
    -> Word32
    -- ^ /@domain@/: the GStreamer GError domain this message belongs to
    -> Int32
    -- ^ /@code@/: the GError code belonging to the domain
    -> Maybe (T.Text)
    -- ^ /@text@/: an allocated text string to be used
    --            as a replacement for the default message connected to code,
    --            or 'P.Nothing'
    -> Maybe (T.Text)
    -- ^ /@debug@/: an allocated debug message to be
    --            used as a replacement for the default debugging information,
    --            or 'P.Nothing'
    -> T.Text
    -- ^ /@file@/: the source code file where the error was generated
    -> T.Text
    -- ^ /@function@/: the source code function where the error was generated
    -> Int32
    -- ^ /@line@/: the source code line where the error was generated
    -> Gst.Structure.Structure
    -- ^ /@structure@/: optional details structure
    -> m ()
elementMessageFullWithDetails :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsElement a) =>
a
-> [MessageType]
-> Word32
-> Int32
-> Maybe Text
-> Maybe Text
-> Text
-> Text
-> Int32
-> Structure
-> m ()
elementMessageFullWithDetails a
element [MessageType]
type_ Word32
domain Int32
code Maybe Text
text Maybe Text
debug Text
file Text
function Int32
line Structure
structure = 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 Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    let type_' :: CUInt
type_' = [MessageType] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [MessageType]
type_
    Ptr CChar
maybeText <- case Maybe Text
text of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jText -> do
            Ptr CChar
jText' <- Text -> IO (Ptr CChar)
textToCString Text
jText
            Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jText'
    Ptr CChar
maybeDebug <- case Maybe Text
debug of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jDebug -> do
            Ptr CChar
jDebug' <- Text -> IO (Ptr CChar)
textToCString Text
jDebug
            Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jDebug'
    Ptr CChar
file' <- Text -> IO (Ptr CChar)
textToCString Text
file
    Ptr CChar
function' <- Text -> IO (Ptr CChar)
textToCString Text
function
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Structure
structure
    Ptr Element
-> CUInt
-> Word32
-> Int32
-> Ptr CChar
-> Ptr CChar
-> Ptr CChar
-> Ptr CChar
-> Int32
-> Ptr Structure
-> IO ()
gst_element_message_full_with_details Ptr Element
element' CUInt
type_' Word32
domain Int32
code Ptr CChar
maybeText Ptr CChar
maybeDebug Ptr CChar
file' Ptr CChar
function' Int32
line Ptr Structure
structure'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
element
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
file'
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
function'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ElementMessageFullWithDetailsMethodInfo
instance (signature ~ ([Gst.Flags.MessageType] -> Word32 -> Int32 -> Maybe (T.Text) -> Maybe (T.Text) -> T.Text -> T.Text -> Int32 -> Gst.Structure.Structure -> m ()), MonadIO m, IsElement a) => O.OverloadedMethod ElementMessageFullWithDetailsMethodInfo a signature where
    overloadedMethod = elementMessageFullWithDetails

instance O.OverloadedMethodInfo ElementMessageFullWithDetailsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementMessageFullWithDetails",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementMessageFullWithDetails"
        })


#endif

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

foreign import ccall "gst_element_no_more_pads" gst_element_no_more_pads :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    IO ()

-- | Use this function to signal that the element does not expect any more pads
-- to show up in the current pipeline. This function should be called whenever
-- pads have been added by the element itself. Elements with @/GST_PAD_SOMETIMES/@
-- pad templates use this in combination with autopluggers to figure out that
-- the element is done initializing its pads.
-- 
-- This function emits the [Element::noMorePads]("GI.Gst.Objects.Element#g:signal:noMorePads") signal.
-- 
-- MT safe.
elementNoMorePads ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element'
    -> m ()
elementNoMorePads :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsElement a) =>
a -> m ()
elementNoMorePads a
element = 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 Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    Ptr Element -> IO ()
gst_element_no_more_pads Ptr Element
element'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
element
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ElementNoMorePadsMethodInfo
instance (signature ~ (m ()), MonadIO m, IsElement a) => O.OverloadedMethod ElementNoMorePadsMethodInfo a signature where
    overloadedMethod = elementNoMorePads

instance O.OverloadedMethodInfo ElementNoMorePadsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementNoMorePads",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementNoMorePads"
        })


#endif

-- method Element::post_message
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstElement posting the message"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstMessage to post"
--                 , 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_element_post_message" gst_element_post_message :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    Ptr Gst.Message.Message ->              -- message : TInterface (Name {namespace = "Gst", name = "Message"})
    IO CInt

-- | Post a message on the element\'s t'GI.Gst.Objects.Bus.Bus'. This function takes ownership of the
-- message; if you want to access the message after this call, you should add an
-- additional reference before calling.
elementPostMessage ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element' posting the message
    -> Gst.Message.Message
    -- ^ /@message@/: a t'GI.Gst.Structs.Message.Message' to post
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the message was successfully posted. The function returns
    -- 'P.False' if the element did not have a bus.
    -- 
    -- MT safe.
elementPostMessage :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsElement a) =>
a -> Message -> m Bool
elementPostMessage a
element Message
message = 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 Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    Ptr Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Message
message
    CInt
result <- Ptr Element -> Ptr Message -> IO CInt
gst_element_post_message Ptr Element
element' Ptr Message
message'
    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
element
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ElementPostMessageMethodInfo
instance (signature ~ (Gst.Message.Message -> m Bool), MonadIO m, IsElement a) => O.OverloadedMethod ElementPostMessageMethodInfo a signature where
    overloadedMethod = elementPostMessage

instance O.OverloadedMethodInfo ElementPostMessageMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementPostMessage",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementPostMessage"
        })


#endif

-- method Element::provide_clock
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstElement to query"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Clock" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_element_provide_clock" gst_element_provide_clock :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    IO (Ptr Gst.Clock.Clock)

-- | Get the clock provided by the given element.
-- > An element is only required to provide a clock in the PAUSED
-- > state. Some elements can provide a clock in other states.
elementProvideClock ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element' to query
    -> m (Maybe Gst.Clock.Clock)
    -- ^ __Returns:__ the GstClock provided by the
    -- element or 'P.Nothing' if no clock could be provided.  Unref after usage.
    -- 
    -- MT safe.
elementProvideClock :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsElement a) =>
a -> m (Maybe Clock)
elementProvideClock a
element = IO (Maybe Clock) -> m (Maybe Clock)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Clock) -> m (Maybe Clock))
-> IO (Maybe Clock) -> m (Maybe Clock)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    Ptr Clock
result <- Ptr Element -> IO (Ptr Clock)
gst_element_provide_clock Ptr Element
element'
    Maybe Clock
maybeResult <- Ptr Clock -> (Ptr Clock -> IO Clock) -> IO (Maybe Clock)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Clock
result ((Ptr Clock -> IO Clock) -> IO (Maybe Clock))
-> (Ptr Clock -> IO Clock) -> IO (Maybe Clock)
forall a b. (a -> b) -> a -> b
$ \Ptr Clock
result' -> do
        Clock
result'' <- ((ManagedPtr Clock -> Clock) -> Ptr Clock -> IO Clock
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Clock -> Clock
Gst.Clock.Clock) Ptr Clock
result'
        Clock -> IO Clock
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Clock
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
element
    Maybe Clock -> IO (Maybe Clock)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Clock
maybeResult

#if defined(ENABLE_OVERLOADING)
data ElementProvideClockMethodInfo
instance (signature ~ (m (Maybe Gst.Clock.Clock)), MonadIO m, IsElement a) => O.OverloadedMethod ElementProvideClockMethodInfo a signature where
    overloadedMethod = elementProvideClock

instance O.OverloadedMethodInfo ElementProvideClockMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementProvideClock",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementProvideClock"
        })


#endif

-- method Element::query
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstElement to perform the query on."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstQuery." , 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_element_query" gst_element_query :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    Ptr Gst.Query.Query ->                  -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    IO CInt

-- | Performs a query on the given element.
-- 
-- For elements that don\'t implement a query handler, this function
-- forwards the query to a random srcpad or to the peer of a
-- random linked sinkpad of this element.
-- 
-- Please note that some queries might need a running pipeline to work.
elementQuery ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element' to perform the query on.
    -> Gst.Query.Query
    -- ^ /@query@/: the t'GI.Gst.Structs.Query.Query'.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the query could be performed.
    -- 
    -- MT safe.
elementQuery :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsElement a) =>
a -> Query -> m Bool
elementQuery a
element Query
query = 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 Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    CInt
result <- Ptr Element -> Ptr Query -> IO CInt
gst_element_query Ptr Element
element' Ptr Query
query'
    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
element
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ElementQueryMethodInfo
instance (signature ~ (Gst.Query.Query -> m Bool), MonadIO m, IsElement a) => O.OverloadedMethod ElementQueryMethodInfo a signature where
    overloadedMethod = elementQuery

instance O.OverloadedMethodInfo ElementQueryMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementQuery",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementQuery"
        })


#endif

-- method Element::query_convert
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstElement to invoke the convert query on."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "src_format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstFormat to convert from."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "src_val"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a value to convert."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dest_format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstFormat to convert to."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dest_val"
--           , argType = TBasicType TInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a pointer to the result."
--                 , 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_element_query_convert" gst_element_query_convert :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    CUInt ->                                -- src_format : TInterface (Name {namespace = "Gst", name = "Format"})
    Int64 ->                                -- src_val : TBasicType TInt64
    CUInt ->                                -- dest_format : TInterface (Name {namespace = "Gst", name = "Format"})
    Ptr Int64 ->                            -- dest_val : TBasicType TInt64
    IO CInt

-- | Queries an element to convert /@srcVal@/ in /@srcFormat@/ to /@destFormat@/.
elementQueryConvert ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element' to invoke the convert query on.
    -> Gst.Enums.Format
    -- ^ /@srcFormat@/: a t'GI.Gst.Enums.Format' to convert from.
    -> Int64
    -- ^ /@srcVal@/: a value to convert.
    -> Gst.Enums.Format
    -- ^ /@destFormat@/: the t'GI.Gst.Enums.Format' to convert to.
    -> m ((Bool, Int64))
    -- ^ __Returns:__ 'P.True' if the query could be performed.
elementQueryConvert :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsElement a) =>
a -> Format -> Int64 -> Format -> m (Bool, Int64)
elementQueryConvert a
element Format
srcFormat Int64
srcVal Format
destFormat = IO (Bool, Int64) -> m (Bool, Int64)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Int64) -> m (Bool, Int64))
-> IO (Bool, Int64) -> m (Bool, Int64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    let srcFormat' :: CUInt
srcFormat' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Format -> Int) -> Format -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Int
forall a. Enum a => a -> Int
fromEnum) Format
srcFormat
    let destFormat' :: CUInt
destFormat' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Format -> Int) -> Format -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Int
forall a. Enum a => a -> Int
fromEnum) Format
destFormat
    Ptr Int64
destVal <- IO (Ptr Int64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int64)
    CInt
result <- Ptr Element -> CUInt -> Int64 -> CUInt -> Ptr Int64 -> IO CInt
gst_element_query_convert Ptr Element
element' CUInt
srcFormat' Int64
srcVal CUInt
destFormat' Ptr Int64
destVal
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Int64
destVal' <- Ptr Int64 -> IO Int64
forall a. Storable a => Ptr a -> IO a
peek Ptr Int64
destVal
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
element
    Ptr Int64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int64
destVal
    (Bool, Int64) -> IO (Bool, Int64)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Int64
destVal')

#if defined(ENABLE_OVERLOADING)
data ElementQueryConvertMethodInfo
instance (signature ~ (Gst.Enums.Format -> Int64 -> Gst.Enums.Format -> m ((Bool, Int64))), MonadIO m, IsElement a) => O.OverloadedMethod ElementQueryConvertMethodInfo a signature where
    overloadedMethod = elementQueryConvert

instance O.OverloadedMethodInfo ElementQueryConvertMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementQueryConvert",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementQueryConvert"
        })


#endif

-- method Element::query_duration
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GstElement to invoke the duration query on."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstFormat requested"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "duration"
--           , argType = TBasicType TInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A location in which to store the total duration, or %NULL."
--                 , 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_element_query_duration" gst_element_query_duration :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    CUInt ->                                -- format : TInterface (Name {namespace = "Gst", name = "Format"})
    Ptr Int64 ->                            -- duration : TBasicType TInt64
    IO CInt

-- | Queries an element (usually top-level pipeline or playbin element) for the
-- total stream duration in nanoseconds. This query will only work once the
-- pipeline is prerolled (i.e. reached PAUSED or PLAYING state). The application
-- will receive an ASYNC_DONE message on the pipeline bus when that is the case.
-- 
-- If the duration changes for some reason, you will get a DURATION_CHANGED
-- message on the pipeline bus, in which case you should re-query the duration
-- using this function.
elementQueryDuration ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element' to invoke the duration query on.
    -> Gst.Enums.Format
    -- ^ /@format@/: the t'GI.Gst.Enums.Format' requested
    -> m ((Bool, Int64))
    -- ^ __Returns:__ 'P.True' if the query could be performed.
elementQueryDuration :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsElement a) =>
a -> Format -> m (Bool, Int64)
elementQueryDuration a
element Format
format = IO (Bool, Int64) -> m (Bool, Int64)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Int64) -> m (Bool, Int64))
-> IO (Bool, Int64) -> m (Bool, Int64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    let format' :: CUInt
format' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Format -> Int) -> Format -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Int
forall a. Enum a => a -> Int
fromEnum) Format
format
    Ptr Int64
duration <- IO (Ptr Int64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int64)
    CInt
result <- Ptr Element -> CUInt -> Ptr Int64 -> IO CInt
gst_element_query_duration Ptr Element
element' CUInt
format' Ptr Int64
duration
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Int64
duration' <- Ptr Int64 -> IO Int64
forall a. Storable a => Ptr a -> IO a
peek Ptr Int64
duration
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
element
    Ptr Int64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int64
duration
    (Bool, Int64) -> IO (Bool, Int64)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Int64
duration')

#if defined(ENABLE_OVERLOADING)
data ElementQueryDurationMethodInfo
instance (signature ~ (Gst.Enums.Format -> m ((Bool, Int64))), MonadIO m, IsElement a) => O.OverloadedMethod ElementQueryDurationMethodInfo a signature where
    overloadedMethod = elementQueryDuration

instance O.OverloadedMethodInfo ElementQueryDurationMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementQueryDuration",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementQueryDuration"
        })


#endif

-- method Element::query_position
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GstElement to invoke the position query on."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstFormat requested"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cur"
--           , argType = TBasicType TInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a location in which to store the current\n    position, or %NULL."
--                 , 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_element_query_position" gst_element_query_position :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    CUInt ->                                -- format : TInterface (Name {namespace = "Gst", name = "Format"})
    Ptr Int64 ->                            -- cur : TBasicType TInt64
    IO CInt

-- | Queries an element (usually top-level pipeline or playbin element) for the
-- stream position in nanoseconds. This will be a value between 0 and the
-- stream duration (if the stream duration is known). This query will usually
-- only work once the pipeline is prerolled (i.e. reached PAUSED or PLAYING
-- state). The application will receive an ASYNC_DONE message on the pipeline
-- bus when that is the case.
-- 
-- If one repeatedly calls this function one can also create a query and reuse
-- it in 'GI.Gst.Objects.Element.elementQuery'.
elementQueryPosition ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element' to invoke the position query on.
    -> Gst.Enums.Format
    -- ^ /@format@/: the t'GI.Gst.Enums.Format' requested
    -> m ((Bool, Int64))
    -- ^ __Returns:__ 'P.True' if the query could be performed.
elementQueryPosition :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsElement a) =>
a -> Format -> m (Bool, Int64)
elementQueryPosition a
element Format
format = IO (Bool, Int64) -> m (Bool, Int64)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Int64) -> m (Bool, Int64))
-> IO (Bool, Int64) -> m (Bool, Int64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    let format' :: CUInt
format' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Format -> Int) -> Format -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Int
forall a. Enum a => a -> Int
fromEnum) Format
format
    Ptr Int64
cur <- IO (Ptr Int64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int64)
    CInt
result <- Ptr Element -> CUInt -> Ptr Int64 -> IO CInt
gst_element_query_position Ptr Element
element' CUInt
format' Ptr Int64
cur
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Int64
cur' <- Ptr Int64 -> IO Int64
forall a. Storable a => Ptr a -> IO a
peek Ptr Int64
cur
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
element
    Ptr Int64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int64
cur
    (Bool, Int64) -> IO (Bool, Int64)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Int64
cur')

#if defined(ENABLE_OVERLOADING)
data ElementQueryPositionMethodInfo
instance (signature ~ (Gst.Enums.Format -> m ((Bool, Int64))), MonadIO m, IsElement a) => O.OverloadedMethod ElementQueryPositionMethodInfo a signature where
    overloadedMethod = elementQueryPosition

instance O.OverloadedMethodInfo ElementQueryPositionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementQueryPosition",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementQueryPosition"
        })


#endif

-- method Element::release_request_pad
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstElement to release the request pad of."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstPad to release."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_element_release_request_pad" gst_element_release_request_pad :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    Ptr Gst.Pad.Pad ->                      -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    IO ()

-- | Makes the element free the previously requested pad as obtained
-- with 'GI.Gst.Objects.Element.elementRequestPad'.
-- 
-- This does not unref the pad. If the pad was created by using
-- 'GI.Gst.Objects.Element.elementRequestPad', 'GI.Gst.Objects.Element.elementReleaseRequestPad' needs to be
-- followed by 'GI.Gst.Objects.Object.objectUnref' to free the /@pad@/.
-- 
-- MT safe.
elementReleaseRequestPad ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a, Gst.Pad.IsPad b) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element' to release the request pad of.
    -> b
    -- ^ /@pad@/: the t'GI.Gst.Objects.Pad.Pad' to release.
    -> m ()
elementReleaseRequestPad :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsElement a, IsPad b) =>
a -> b -> m ()
elementReleaseRequestPad a
element b
pad = 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 Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    Ptr Pad
pad' <- b -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
pad
    Ptr Element -> Ptr Pad -> IO ()
gst_element_release_request_pad Ptr Element
element' Ptr Pad
pad'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
element
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
pad
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ElementReleaseRequestPadMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsElement a, Gst.Pad.IsPad b) => O.OverloadedMethod ElementReleaseRequestPadMethodInfo a signature where
    overloadedMethod = elementReleaseRequestPad

instance O.OverloadedMethodInfo ElementReleaseRequestPadMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementReleaseRequestPad",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementReleaseRequestPad"
        })


#endif

-- method Element::remove_pad
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstElement to remove pad from."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstPad to remove from the element."
--                 , 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_element_remove_pad" gst_element_remove_pad :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    Ptr Gst.Pad.Pad ->                      -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    IO CInt

-- | Removes /@pad@/ from /@element@/. /@pad@/ will be destroyed if it has not been
-- referenced elsewhere using 'GI.Gst.Objects.Object.objectUnparent'.
-- 
-- This function is used by plugin developers and should not be used
-- by applications. Pads that were dynamically requested from elements
-- with 'GI.Gst.Objects.Element.elementRequestPad' should be released with the
-- 'GI.Gst.Objects.Element.elementReleaseRequestPad' function instead.
-- 
-- Pads are not automatically deactivated so elements should perform the needed
-- steps to deactivate the pad in case this pad is removed in the PAUSED or
-- PLAYING state. See 'GI.Gst.Objects.Pad.padSetActive' for more information about
-- deactivating pads.
-- 
-- The pad and the element should be unlocked when calling this function.
-- 
-- This function will emit the [Element::padRemoved]("GI.Gst.Objects.Element#g:signal:padRemoved") signal on the element.
elementRemovePad ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a, Gst.Pad.IsPad b) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element' to remove pad from.
    -> b
    -- ^ /@pad@/: the t'GI.Gst.Objects.Pad.Pad' to remove from the element.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the pad could be removed. Can return 'P.False' if the
    -- pad does not belong to the provided element.
    -- 
    -- MT safe.
elementRemovePad :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsElement a, IsPad b) =>
a -> b -> m Bool
elementRemovePad a
element b
pad = 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 Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    Ptr Pad
pad' <- b -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
pad
    CInt
result <- Ptr Element -> Ptr Pad -> IO CInt
gst_element_remove_pad Ptr Element
element' Ptr Pad
pad'
    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
element
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
pad
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ElementRemovePadMethodInfo
instance (signature ~ (b -> m Bool), MonadIO m, IsElement a, Gst.Pad.IsPad b) => O.OverloadedMethod ElementRemovePadMethodInfo a signature where
    overloadedMethod = elementRemovePad

instance O.OverloadedMethodInfo ElementRemovePadMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementRemovePad",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementRemovePad"
        })


#endif

-- method Element::remove_property_notify_watch
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GstElement being watched for property changes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "watch_id"
--           , argType = TBasicType TULong
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "watch id 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_element_remove_property_notify_watch" gst_element_remove_property_notify_watch :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    CULong ->                               -- watch_id : TBasicType TULong
    IO ()

-- | /No description available in the introspection data./
-- 
-- /Since: 1.10/
elementRemovePropertyNotifyWatch ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element' being watched for property changes
    -> CULong
    -- ^ /@watchId@/: watch id to remove
    -> m ()
elementRemovePropertyNotifyWatch :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsElement a) =>
a -> SignalHandlerId -> m ()
elementRemovePropertyNotifyWatch a
element SignalHandlerId
watchId = 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 Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    Ptr Element -> SignalHandlerId -> IO ()
gst_element_remove_property_notify_watch Ptr Element
element' SignalHandlerId
watchId
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
element
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ElementRemovePropertyNotifyWatchMethodInfo
instance (signature ~ (CULong -> m ()), MonadIO m, IsElement a) => O.OverloadedMethod ElementRemovePropertyNotifyWatchMethodInfo a signature where
    overloadedMethod = elementRemovePropertyNotifyWatch

instance O.OverloadedMethodInfo ElementRemovePropertyNotifyWatchMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementRemovePropertyNotifyWatch",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementRemovePropertyNotifyWatch"
        })


#endif

-- method Element::request_pad
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstElement to find a request pad of."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "templ"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "PadTemplate" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstPadTemplate of which we want a pad of."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the name of the request #GstPad\nto retrieve. Can be %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "caps"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the caps of the pad we want to\nrequest. Can be %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Pad" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_element_request_pad" gst_element_request_pad :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    Ptr Gst.PadTemplate.PadTemplate ->      -- templ : TInterface (Name {namespace = "Gst", name = "PadTemplate"})
    CString ->                              -- name : TBasicType TUTF8
    Ptr Gst.Caps.Caps ->                    -- caps : TInterface (Name {namespace = "Gst", name = "Caps"})
    IO (Ptr Gst.Pad.Pad)

-- | Retrieves a request pad from the element according to the provided template.
-- Pad templates can be looked up using
-- 'GI.Gst.Objects.ElementFactory.elementFactoryGetStaticPadTemplates'.
-- 
-- The pad should be released with 'GI.Gst.Objects.Element.elementReleaseRequestPad'.
elementRequestPad ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a, Gst.PadTemplate.IsPadTemplate b) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element' to find a request pad of.
    -> b
    -- ^ /@templ@/: a t'GI.Gst.Objects.PadTemplate.PadTemplate' of which we want a pad of.
    -> Maybe (T.Text)
    -- ^ /@name@/: the name of the request t'GI.Gst.Objects.Pad.Pad'
    -- to retrieve. Can be 'P.Nothing'.
    -> Maybe (Gst.Caps.Caps)
    -- ^ /@caps@/: the caps of the pad we want to
    -- request. Can be 'P.Nothing'.
    -> m (Maybe Gst.Pad.Pad)
    -- ^ __Returns:__ requested t'GI.Gst.Objects.Pad.Pad' if found,
    --     otherwise 'P.Nothing'.  Release after usage.
elementRequestPad :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsElement a, IsPadTemplate b) =>
a -> b -> Maybe Text -> Maybe Caps -> m (Maybe Pad)
elementRequestPad a
element b
templ Maybe Text
name Maybe Caps
caps = IO (Maybe Pad) -> m (Maybe Pad)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Pad) -> m (Maybe Pad))
-> IO (Maybe Pad) -> m (Maybe Pad)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    Ptr PadTemplate
templ' <- b -> IO (Ptr PadTemplate)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
templ
    Ptr CChar
maybeName <- case Maybe Text
name of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jName -> do
            Ptr CChar
jName' <- Text -> IO (Ptr CChar)
textToCString Text
jName
            Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jName'
    Ptr Caps
maybeCaps <- case Maybe Caps
caps of
        Maybe Caps
Nothing -> Ptr Caps -> IO (Ptr Caps)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Caps
forall a. Ptr a
nullPtr
        Just Caps
jCaps -> do
            Ptr Caps
jCaps' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
jCaps
            Ptr Caps -> IO (Ptr Caps)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Caps
jCaps'
    Ptr Pad
result <- Ptr Element
-> Ptr PadTemplate -> Ptr CChar -> Ptr Caps -> IO (Ptr Pad)
gst_element_request_pad Ptr Element
element' Ptr PadTemplate
templ' Ptr CChar
maybeName Ptr Caps
maybeCaps
    Maybe Pad
maybeResult <- Ptr Pad -> (Ptr Pad -> IO Pad) -> IO (Maybe Pad)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Pad
result ((Ptr Pad -> IO Pad) -> IO (Maybe Pad))
-> (Ptr Pad -> IO Pad) -> IO (Maybe Pad)
forall a b. (a -> b) -> a -> b
$ \Ptr Pad
result' -> do
        Pad
result'' <- ((ManagedPtr Pad -> Pad) -> Ptr Pad -> IO Pad
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Pad -> Pad
Gst.Pad.Pad) Ptr Pad
result'
        Pad -> IO Pad
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Pad
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
element
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
templ
    Maybe Caps -> (Caps -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Caps
caps Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeName
    Maybe Pad -> IO (Maybe Pad)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Pad
maybeResult

#if defined(ENABLE_OVERLOADING)
data ElementRequestPadMethodInfo
instance (signature ~ (b -> Maybe (T.Text) -> Maybe (Gst.Caps.Caps) -> m (Maybe Gst.Pad.Pad)), MonadIO m, IsElement a, Gst.PadTemplate.IsPadTemplate b) => O.OverloadedMethod ElementRequestPadMethodInfo a signature where
    overloadedMethod = elementRequestPad

instance O.OverloadedMethodInfo ElementRequestPadMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementRequestPad",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementRequestPad"
        })


#endif

-- method Element::request_pad_simple
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstElement to find a request pad of."
--                 , 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 request #GstPad to retrieve."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Pad" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_element_request_pad_simple" gst_element_request_pad_simple :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    CString ->                              -- name : TBasicType TUTF8
    IO (Ptr Gst.Pad.Pad)

-- | Retrieves a pad from the element by name (e.g. \"src_%d\"). This version only
-- retrieves request pads. The pad should be released with
-- 'GI.Gst.Objects.Element.elementReleaseRequestPad'.
-- 
-- This method is slower than manually getting the pad template and calling
-- 'GI.Gst.Objects.Element.elementRequestPad' if the pads should have a specific name (e.g.
-- /@name@/ is \"src_1\" instead of \"src_%u\").
-- 
-- Note that this function was introduced in GStreamer 1.20 in order to provide
-- a better name to 'GI.Gst.Objects.Element.elementGetRequestPad'. Prior to 1.20, users
-- should use 'GI.Gst.Objects.Element.elementGetRequestPad' which provides the same
-- functionality.
-- 
-- /Since: 1.20/
elementRequestPadSimple ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element' to find a request pad of.
    -> T.Text
    -- ^ /@name@/: the name of the request t'GI.Gst.Objects.Pad.Pad' to retrieve.
    -> m (Maybe Gst.Pad.Pad)
    -- ^ __Returns:__ requested t'GI.Gst.Objects.Pad.Pad' if found,
    --     otherwise 'P.Nothing'.  Release after usage.
elementRequestPadSimple :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsElement a) =>
a -> Text -> m (Maybe Pad)
elementRequestPadSimple a
element Text
name = IO (Maybe Pad) -> m (Maybe Pad)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Pad) -> m (Maybe Pad))
-> IO (Maybe Pad) -> m (Maybe Pad)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    Ptr CChar
name' <- Text -> IO (Ptr CChar)
textToCString Text
name
    Ptr Pad
result <- Ptr Element -> Ptr CChar -> IO (Ptr Pad)
gst_element_request_pad_simple Ptr Element
element' Ptr CChar
name'
    Maybe Pad
maybeResult <- Ptr Pad -> (Ptr Pad -> IO Pad) -> IO (Maybe Pad)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Pad
result ((Ptr Pad -> IO Pad) -> IO (Maybe Pad))
-> (Ptr Pad -> IO Pad) -> IO (Maybe Pad)
forall a b. (a -> b) -> a -> b
$ \Ptr Pad
result' -> do
        Pad
result'' <- ((ManagedPtr Pad -> Pad) -> Ptr Pad -> IO Pad
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Pad -> Pad
Gst.Pad.Pad) Ptr Pad
result'
        Pad -> IO Pad
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Pad
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
element
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
name'
    Maybe Pad -> IO (Maybe Pad)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Pad
maybeResult

#if defined(ENABLE_OVERLOADING)
data ElementRequestPadSimpleMethodInfo
instance (signature ~ (T.Text -> m (Maybe Gst.Pad.Pad)), MonadIO m, IsElement a) => O.OverloadedMethod ElementRequestPadSimpleMethodInfo a signature where
    overloadedMethod = elementRequestPadSimple

instance O.OverloadedMethodInfo ElementRequestPadSimpleMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementRequestPadSimple",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementRequestPadSimple"
        })


#endif

-- method Element::seek
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstElement to send the event to."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "rate"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The new playback rate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The format of the seek values"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "SeekFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The optional seek flags."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "start_type"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "SeekType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The type and flags for the new start position"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "start"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The value of the new start position"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "stop_type"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "SeekType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The type and flags for the new stop position"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "stop"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The value of the new stop position"
--                 , 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_element_seek" gst_element_seek :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    CDouble ->                              -- rate : TBasicType TDouble
    CUInt ->                                -- format : TInterface (Name {namespace = "Gst", name = "Format"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gst", name = "SeekFlags"})
    CUInt ->                                -- start_type : TInterface (Name {namespace = "Gst", name = "SeekType"})
    Int64 ->                                -- start : TBasicType TInt64
    CUInt ->                                -- stop_type : TInterface (Name {namespace = "Gst", name = "SeekType"})
    Int64 ->                                -- stop : TBasicType TInt64
    IO CInt

-- | Sends a seek event to an element. See 'GI.Gst.Structs.Event.eventNewSeek' for the details of
-- the parameters. The seek event is sent to the element using
-- 'GI.Gst.Objects.Element.elementSendEvent'.
-- 
-- MT safe.
elementSeek ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element' to send the event to.
    -> Double
    -- ^ /@rate@/: The new playback rate
    -> Gst.Enums.Format
    -- ^ /@format@/: The format of the seek values
    -> [Gst.Flags.SeekFlags]
    -- ^ /@flags@/: The optional seek flags.
    -> Gst.Enums.SeekType
    -- ^ /@startType@/: The type and flags for the new start position
    -> Int64
    -- ^ /@start@/: The value of the new start position
    -> Gst.Enums.SeekType
    -- ^ /@stopType@/: The type and flags for the new stop position
    -> Int64
    -- ^ /@stop@/: The value of the new stop position
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the event was handled. Flushing seeks will trigger a
    -- preroll, which will emit 'GI.Gst.Flags.MessageTypeAsyncDone'.
elementSeek :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsElement a) =>
a
-> Double
-> Format
-> [SeekFlags]
-> SeekType
-> Int64
-> SeekType
-> Int64
-> m Bool
elementSeek a
element Double
rate Format
format [SeekFlags]
flags SeekType
startType Int64
start SeekType
stopType Int64
stop = 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 Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    let rate' :: CDouble
rate' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
rate
    let format' :: CUInt
format' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Format -> Int) -> Format -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Int
forall a. Enum a => a -> Int
fromEnum) Format
format
    let flags' :: CUInt
flags' = [SeekFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [SeekFlags]
flags
    let startType' :: CUInt
startType' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (SeekType -> Int) -> SeekType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SeekType -> Int
forall a. Enum a => a -> Int
fromEnum) SeekType
startType
    let stopType' :: CUInt
stopType' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (SeekType -> Int) -> SeekType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SeekType -> Int
forall a. Enum a => a -> Int
fromEnum) SeekType
stopType
    CInt
result <- Ptr Element
-> CDouble
-> CUInt
-> CUInt
-> CUInt
-> Int64
-> CUInt
-> Int64
-> IO CInt
gst_element_seek Ptr Element
element' CDouble
rate' CUInt
format' CUInt
flags' CUInt
startType' Int64
start CUInt
stopType' Int64
stop
    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
element
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ElementSeekMethodInfo
instance (signature ~ (Double -> Gst.Enums.Format -> [Gst.Flags.SeekFlags] -> Gst.Enums.SeekType -> Int64 -> Gst.Enums.SeekType -> Int64 -> m Bool), MonadIO m, IsElement a) => O.OverloadedMethod ElementSeekMethodInfo a signature where
    overloadedMethod = elementSeek

instance O.OverloadedMethodInfo ElementSeekMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementSeek",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementSeek"
        })


#endif

-- method Element::seek_simple
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstElement to seek on"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a #GstFormat to execute the seek in, such as #GST_FORMAT_TIME"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "seek_flags"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "SeekFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "seek options; playback applications will usually want to use\n           GST_SEEK_FLAG_FLUSH | GST_SEEK_FLAG_KEY_UNIT here"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "seek_pos"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "position to seek to (relative to the start); if you are doing\n           a seek in #GST_FORMAT_TIME this value is in nanoseconds -\n           multiply with #GST_SECOND to convert seconds to nanoseconds or\n           with #GST_MSECOND to convert milliseconds to nanoseconds."
--                 , 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_element_seek_simple" gst_element_seek_simple :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    CUInt ->                                -- format : TInterface (Name {namespace = "Gst", name = "Format"})
    CUInt ->                                -- seek_flags : TInterface (Name {namespace = "Gst", name = "SeekFlags"})
    Int64 ->                                -- seek_pos : TBasicType TInt64
    IO CInt

-- | Simple API to perform a seek on the given element, meaning it just seeks
-- to the given position relative to the start of the stream. For more complex
-- operations like segment seeks (e.g. for looping) or changing the playback
-- rate or seeking relative to the last configured playback segment you should
-- use 'GI.Gst.Objects.Element.elementSeek'.
-- 
-- In a completely prerolled PAUSED or PLAYING pipeline, seeking is always
-- guaranteed to return 'P.True' on a seekable media type or 'P.False' when the media
-- type is certainly not seekable (such as a live stream).
-- 
-- Some elements allow for seeking in the READY state, in this
-- case they will store the seek event and execute it when they are put to
-- PAUSED. If the element supports seek in READY, it will always return 'P.True' when
-- it receives the event in the READY state.
elementSeekSimple ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element' to seek on
    -> Gst.Enums.Format
    -- ^ /@format@/: a t'GI.Gst.Enums.Format' to execute the seek in, such as @/GST_FORMAT_TIME/@
    -> [Gst.Flags.SeekFlags]
    -- ^ /@seekFlags@/: seek options; playback applications will usually want to use
    --            GST_SEEK_FLAG_FLUSH | GST_SEEK_FLAG_KEY_UNIT here
    -> Int64
    -- ^ /@seekPos@/: position to seek to (relative to the start); if you are doing
    --            a seek in @/GST_FORMAT_TIME/@ this value is in nanoseconds -
    --            multiply with 'GI.Gst.Constants.SECOND' to convert seconds to nanoseconds or
    --            with 'GI.Gst.Constants.MSECOND' to convert milliseconds to nanoseconds.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the seek operation succeeded. Flushing seeks will trigger a
    -- preroll, which will emit 'GI.Gst.Flags.MessageTypeAsyncDone'.
elementSeekSimple :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsElement a) =>
a -> Format -> [SeekFlags] -> Int64 -> m Bool
elementSeekSimple a
element Format
format [SeekFlags]
seekFlags Int64
seekPos = 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 Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    let format' :: CUInt
format' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Format -> Int) -> Format -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Int
forall a. Enum a => a -> Int
fromEnum) Format
format
    let seekFlags' :: CUInt
seekFlags' = [SeekFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [SeekFlags]
seekFlags
    CInt
result <- Ptr Element -> CUInt -> CUInt -> Int64 -> IO CInt
gst_element_seek_simple Ptr Element
element' CUInt
format' CUInt
seekFlags' Int64
seekPos
    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
element
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ElementSeekSimpleMethodInfo
instance (signature ~ (Gst.Enums.Format -> [Gst.Flags.SeekFlags] -> Int64 -> m Bool), MonadIO m, IsElement a) => O.OverloadedMethod ElementSeekSimpleMethodInfo a signature where
    overloadedMethod = elementSeekSimple

instance O.OverloadedMethodInfo ElementSeekSimpleMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementSeekSimple",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementSeekSimple"
        })


#endif

-- method Element::send_event
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstElement to send the event to."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gst" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstEvent to send to the element."
--                 , 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_element_send_event" gst_element_send_event :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    Ptr Gst.Event.Event ->                  -- event : TInterface (Name {namespace = "Gst", name = "Event"})
    IO CInt

-- | Sends an event to an element. If the element doesn\'t implement an
-- event handler, the event will be pushed on a random linked sink pad for
-- downstream events or a random linked source pad for upstream events.
-- 
-- This function takes ownership of the provided event so you should
-- @/gst_event_ref()/@ it if you want to reuse the event after this call.
-- 
-- MT safe.
elementSendEvent ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element' to send the event to.
    -> Gst.Event.Event
    -- ^ /@event@/: the t'GI.Gst.Structs.Event.Event' to send to the element.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the event was handled. Events that trigger a preroll (such
    -- as flushing seeks and steps) will emit 'GI.Gst.Flags.MessageTypeAsyncDone'.
elementSendEvent :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsElement a) =>
a -> Event -> m Bool
elementSendEvent a
element Event
event = 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 Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    Ptr Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Event
event
    CInt
result <- Ptr Element -> Ptr Event -> IO CInt
gst_element_send_event Ptr Element
element' Ptr Event
event'
    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
element
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ElementSendEventMethodInfo
instance (signature ~ (Gst.Event.Event -> m Bool), MonadIO m, IsElement a) => O.OverloadedMethod ElementSendEventMethodInfo a signature where
    overloadedMethod = elementSendEvent

instance O.OverloadedMethodInfo ElementSendEventMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementSendEvent",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementSendEvent"
        })


#endif

-- method Element::set_base_time
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstElement." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "time"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the base time to set."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_element_set_base_time" gst_element_set_base_time :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    Word64 ->                               -- time : TBasicType TUInt64
    IO ()

-- | Set the base time of an element. See 'GI.Gst.Objects.Element.elementGetBaseTime'.
-- 
-- MT safe.
elementSetBaseTime ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element'.
    -> Word64
    -- ^ /@time@/: the base time to set.
    -> m ()
elementSetBaseTime :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsElement a) =>
a -> Word64 -> m ()
elementSetBaseTime a
element Word64
time = 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 Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    Ptr Element -> Word64 -> IO ()
gst_element_set_base_time Ptr Element
element' Word64
time
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
element
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ElementSetBaseTimeMethodInfo
instance (signature ~ (Word64 -> m ()), MonadIO m, IsElement a) => O.OverloadedMethod ElementSetBaseTimeMethodInfo a signature where
    overloadedMethod = elementSetBaseTime

instance O.OverloadedMethodInfo ElementSetBaseTimeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementSetBaseTime",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementSetBaseTime"
        })


#endif

-- method Element::set_bus
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstElement to set the bus of."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "Gst" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstBus to set."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_element_set_bus" gst_element_set_bus :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    Ptr Gst.Bus.Bus ->                      -- bus : TInterface (Name {namespace = "Gst", name = "Bus"})
    IO ()

-- | Sets the bus of the element. Increases the refcount on the bus.
-- For internal use only, unless you\'re testing elements.
-- 
-- MT safe.
elementSetBus ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a, Gst.Bus.IsBus b) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element' to set the bus of.
    -> Maybe (b)
    -- ^ /@bus@/: the t'GI.Gst.Objects.Bus.Bus' to set.
    -> m ()
elementSetBus :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsElement a, IsBus b) =>
a -> Maybe b -> m ()
elementSetBus a
element Maybe b
bus = 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 Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    Ptr Bus
maybeBus <- case Maybe b
bus of
        Maybe b
Nothing -> Ptr Bus -> IO (Ptr Bus)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Bus
forall a. Ptr a
nullPtr
        Just b
jBus -> do
            Ptr Bus
jBus' <- b -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jBus
            Ptr Bus -> IO (Ptr Bus)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Bus
jBus'
    Ptr Element -> Ptr Bus -> IO ()
gst_element_set_bus Ptr Element
element' Ptr Bus
maybeBus
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
element
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
bus b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ElementSetBusMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsElement a, Gst.Bus.IsBus b) => O.OverloadedMethod ElementSetBusMethodInfo a signature where
    overloadedMethod = elementSetBus

instance O.OverloadedMethodInfo ElementSetBusMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementSetBus",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementSetBus"
        })


#endif

-- method Element::set_clock
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstElement to set the clock for."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "clock"
--           , argType = TInterface Name { namespace = "Gst" , name = "Clock" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstClock to set for the element."
--                 , 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_element_set_clock" gst_element_set_clock :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    Ptr Gst.Clock.Clock ->                  -- clock : TInterface (Name {namespace = "Gst", name = "Clock"})
    IO CInt

-- | Sets the clock for the element. This function increases the
-- refcount on the clock. Any previously set clock on the object
-- is unreffed.
elementSetClock ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a, Gst.Clock.IsClock b) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element' to set the clock for.
    -> Maybe (b)
    -- ^ /@clock@/: the t'GI.Gst.Objects.Clock.Clock' to set for the element.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the element accepted the clock. An element can refuse a
    -- clock when it, for example, is not able to slave its internal clock to the
    -- /@clock@/ or when it requires a specific clock to operate.
    -- 
    -- MT safe.
elementSetClock :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsElement a, IsClock b) =>
a -> Maybe b -> m Bool
elementSetClock a
element Maybe b
clock = 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 Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    Ptr Clock
maybeClock <- case Maybe b
clock of
        Maybe b
Nothing -> Ptr Clock -> IO (Ptr Clock)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Clock
forall a. Ptr a
nullPtr
        Just b
jClock -> do
            Ptr Clock
jClock' <- b -> IO (Ptr Clock)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jClock
            Ptr Clock -> IO (Ptr Clock)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Clock
jClock'
    CInt
result <- Ptr Element -> Ptr Clock -> IO CInt
gst_element_set_clock Ptr Element
element' Ptr Clock
maybeClock
    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
element
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
clock b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ElementSetClockMethodInfo
instance (signature ~ (Maybe (b) -> m Bool), MonadIO m, IsElement a, Gst.Clock.IsClock b) => O.OverloadedMethod ElementSetClockMethodInfo a signature where
    overloadedMethod = elementSetClock

instance O.OverloadedMethodInfo ElementSetClockMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementSetClock",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementSetClock"
        })


#endif

-- method Element::set_context
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstElement to set the context of."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Context" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstContext to set."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_element_set_context" gst_element_set_context :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    Ptr Gst.Context.Context ->              -- context : TInterface (Name {namespace = "Gst", name = "Context"})
    IO ()

-- | Sets the context of the element. Increases the refcount of the context.
-- 
-- MT safe.
elementSetContext ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element' to set the context of.
    -> Gst.Context.Context
    -- ^ /@context@/: the t'GI.Gst.Structs.Context.Context' to set.
    -> m ()
elementSetContext :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsElement a) =>
a -> Context -> m ()
elementSetContext a
element Context
context = 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 Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    Ptr Context
context' <- Context -> IO (Ptr Context)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Context
context
    Ptr Element -> Ptr Context -> IO ()
gst_element_set_context Ptr Element
element' Ptr Context
context'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
element
    Context -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Context
context
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ElementSetContextMethodInfo
instance (signature ~ (Gst.Context.Context -> m ()), MonadIO m, IsElement a) => O.OverloadedMethod ElementSetContextMethodInfo a signature where
    overloadedMethod = elementSetContext

instance O.OverloadedMethodInfo ElementSetContextMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementSetContext",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementSetContext"
        })


#endif

-- method Element::set_locked_state
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstElement" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "locked_state"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "%TRUE to lock the element's state"
--                 , 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_element_set_locked_state" gst_element_set_locked_state :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    CInt ->                                 -- locked_state : TBasicType TBoolean
    IO CInt

-- | Locks the state of an element, so state changes of the parent don\'t affect
-- this element anymore.
-- 
-- Note that this is racy if the state lock of the parent bin is not taken.
-- The parent bin might\'ve just checked the flag in another thread and as the
-- next step proceed to change the child element\'s state.
-- 
-- MT safe.
elementSetLockedState ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element'
    -> Bool
    -- ^ /@lockedState@/: 'P.True' to lock the element\'s state
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the state was changed, 'P.False' if bad parameters were given
    -- or the elements state-locking needed no change.
elementSetLockedState :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsElement a) =>
a -> Bool -> m Bool
elementSetLockedState a
element Bool
lockedState = 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 Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    let lockedState' :: CInt
lockedState' = (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
lockedState
    CInt
result <- Ptr Element -> CInt -> IO CInt
gst_element_set_locked_state Ptr Element
element' CInt
lockedState'
    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
element
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ElementSetLockedStateMethodInfo
instance (signature ~ (Bool -> m Bool), MonadIO m, IsElement a) => O.OverloadedMethod ElementSetLockedStateMethodInfo a signature where
    overloadedMethod = elementSetLockedState

instance O.OverloadedMethodInfo ElementSetLockedStateMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementSetLockedState",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementSetLockedState"
        })


#endif

-- method Element::set_start_time
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstElement." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "time"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the base time to set."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_element_set_start_time" gst_element_set_start_time :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    Word64 ->                               -- time : TBasicType TUInt64
    IO ()

-- | Set the start time of an element. The start time of the element is the
-- running time of the element when it last went to the PAUSED state. In READY
-- or after a flushing seek, it is set to 0.
-- 
-- Toplevel elements like t'GI.Gst.Objects.Pipeline.Pipeline' will manage the start_time and
-- base_time on its children. Setting the start_time to 'GI.Gst.Constants.CLOCK_TIME_NONE'
-- on such a toplevel element will disable the distribution of the base_time to
-- the children and can be useful if the application manages the base_time
-- itself, for example if you want to synchronize capture from multiple
-- pipelines, and you can also ensure that the pipelines have the same clock.
-- 
-- MT safe.
elementSetStartTime ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element'.
    -> Word64
    -- ^ /@time@/: the base time to set.
    -> m ()
elementSetStartTime :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsElement a) =>
a -> Word64 -> m ()
elementSetStartTime a
element Word64
time = 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 Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    Ptr Element -> Word64 -> IO ()
gst_element_set_start_time Ptr Element
element' Word64
time
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
element
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ElementSetStartTimeMethodInfo
instance (signature ~ (Word64 -> m ()), MonadIO m, IsElement a) => O.OverloadedMethod ElementSetStartTimeMethodInfo a signature where
    overloadedMethod = elementSetStartTime

instance O.OverloadedMethodInfo ElementSetStartTimeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementSetStartTime",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementSetStartTime"
        })


#endif

-- method Element::set_state
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstElement to change state of."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "state"
--           , argType = TInterface Name { namespace = "Gst" , name = "State" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the element's new #GstState."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Gst" , name = "StateChangeReturn" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_element_set_state" gst_element_set_state :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    CUInt ->                                -- state : TInterface (Name {namespace = "Gst", name = "State"})
    IO CUInt

-- | Sets the state of the element. This function will try to set the
-- requested state by going through all the intermediary states and calling
-- the class\'s state change function for each.
-- 
-- This function can return @/GST_STATE_CHANGE_ASYNC/@, in which case the
-- element will perform the remainder of the state change asynchronously in
-- another thread.
-- An application can use 'GI.Gst.Objects.Element.elementGetState' to wait for the completion
-- of the state change or it can wait for a 'GI.Gst.Flags.MessageTypeAsyncDone' or
-- 'GI.Gst.Flags.MessageTypeStateChanged' on the bus.
-- 
-- State changes to 'GI.Gst.Enums.StateReady' or 'GI.Gst.Enums.StateNull' never return
-- @/GST_STATE_CHANGE_ASYNC/@.
elementSetState ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element' to change state of.
    -> Gst.Enums.State
    -- ^ /@state@/: the element\'s new t'GI.Gst.Enums.State'.
    -> m Gst.Enums.StateChangeReturn
    -- ^ __Returns:__ Result of the state change using t'GI.Gst.Enums.StateChangeReturn'.
    -- 
    -- MT safe.
elementSetState :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsElement a) =>
a -> State -> m StateChangeReturn
elementSetState a
element State
state = IO StateChangeReturn -> m StateChangeReturn
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO StateChangeReturn -> m StateChangeReturn)
-> IO StateChangeReturn -> m StateChangeReturn
forall a b. (a -> b) -> a -> b
$ do
    Ptr Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    let state' :: CUInt
state' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (State -> Int) -> State -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> Int
forall a. Enum a => a -> Int
fromEnum) State
state
    CUInt
result <- Ptr Element -> CUInt -> IO CUInt
gst_element_set_state Ptr Element
element' CUInt
state'
    let result' :: StateChangeReturn
result' = (Int -> StateChangeReturn
forall a. Enum a => Int -> a
toEnum (Int -> StateChangeReturn)
-> (CUInt -> Int) -> CUInt -> StateChangeReturn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
element
    StateChangeReturn -> IO StateChangeReturn
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return StateChangeReturn
result'

#if defined(ENABLE_OVERLOADING)
data ElementSetStateMethodInfo
instance (signature ~ (Gst.Enums.State -> m Gst.Enums.StateChangeReturn), MonadIO m, IsElement a) => O.OverloadedMethod ElementSetStateMethodInfo a signature where
    overloadedMethod = elementSetState

instance O.OverloadedMethodInfo ElementSetStateMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementSetState",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementSetState"
        })


#endif

-- method Element::sync_state_with_parent
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstElement." , 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_element_sync_state_with_parent" gst_element_sync_state_with_parent :: 
    Ptr Element ->                          -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    IO CInt

-- | Tries to change the state of the element to the same as its parent.
-- If this function returns 'P.False', the state of element is undefined.
elementSyncStateWithParent ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a) =>
    a
    -- ^ /@element@/: a t'GI.Gst.Objects.Element.Element'.
    -> m Bool
    -- ^ __Returns:__ 'P.True', if the element\'s state could be synced to the parent\'s state.
    -- 
    -- MT safe.
elementSyncStateWithParent :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsElement a) =>
a -> m Bool
elementSyncStateWithParent a
element = 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 Element
element' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
element
    CInt
result <- Ptr Element -> IO CInt
gst_element_sync_state_with_parent Ptr Element
element'
    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
element
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ElementSyncStateWithParentMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsElement a) => O.OverloadedMethod ElementSyncStateWithParentMethodInfo a signature where
    overloadedMethod = elementSyncStateWithParent

instance O.OverloadedMethodInfo ElementSyncStateWithParentMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementSyncStateWithParent",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementSyncStateWithParent"
        })


#endif

-- method Element::unlink
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "src"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the source #GstElement to unlink."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dest"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the sink #GstElement to unlink."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_element_unlink" gst_element_unlink :: 
    Ptr Element ->                          -- src : TInterface (Name {namespace = "Gst", name = "Element"})
    Ptr Element ->                          -- dest : TInterface (Name {namespace = "Gst", name = "Element"})
    IO ()

-- | Unlinks all source pads of the source element with all sink pads
-- of the sink element to which they are linked.
-- 
-- If the link has been made using 'GI.Gst.Objects.Element.elementLink', it could have created an
-- requestpad, which has to be released using 'GI.Gst.Objects.Element.elementReleaseRequestPad'.
elementUnlink ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a, IsElement b) =>
    a
    -- ^ /@src@/: the source t'GI.Gst.Objects.Element.Element' to unlink.
    -> b
    -- ^ /@dest@/: the sink t'GI.Gst.Objects.Element.Element' to unlink.
    -> m ()
elementUnlink :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsElement a, IsElement b) =>
a -> b -> m ()
elementUnlink a
src b
dest = 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 Element
src' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
src
    Ptr Element
dest' <- b -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
dest
    Ptr Element -> Ptr Element -> IO ()
gst_element_unlink Ptr Element
src' Ptr Element
dest'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
src
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
dest
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ElementUnlinkMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsElement a, IsElement b) => O.OverloadedMethod ElementUnlinkMethodInfo a signature where
    overloadedMethod = elementUnlink

instance O.OverloadedMethodInfo ElementUnlinkMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementUnlink",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementUnlink"
        })


#endif

-- method Element::unlink_pads
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "src"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a (transfer none): #GstElement containing the source pad."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "srcpadname"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the #GstPad in source element."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dest"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstElement containing the destination pad."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "destpadname"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the name of the #GstPad in destination element."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_element_unlink_pads" gst_element_unlink_pads :: 
    Ptr Element ->                          -- src : TInterface (Name {namespace = "Gst", name = "Element"})
    CString ->                              -- srcpadname : TBasicType TUTF8
    Ptr Element ->                          -- dest : TInterface (Name {namespace = "Gst", name = "Element"})
    CString ->                              -- destpadname : TBasicType TUTF8
    IO ()

-- | Unlinks the two named pads of the source and destination elements.
-- 
-- This is a convenience function for 'GI.Gst.Objects.Pad.padUnlink'.
elementUnlinkPads ::
    (B.CallStack.HasCallStack, MonadIO m, IsElement a, IsElement b) =>
    a
    -- ^ /@src@/: a (transfer none): t'GI.Gst.Objects.Element.Element' containing the source pad.
    -> T.Text
    -- ^ /@srcpadname@/: the name of the t'GI.Gst.Objects.Pad.Pad' in source element.
    -> b
    -- ^ /@dest@/: a t'GI.Gst.Objects.Element.Element' containing the destination pad.
    -> T.Text
    -- ^ /@destpadname@/: the name of the t'GI.Gst.Objects.Pad.Pad' in destination element.
    -> m ()
elementUnlinkPads :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsElement a, IsElement b) =>
a -> Text -> b -> Text -> m ()
elementUnlinkPads a
src Text
srcpadname b
dest Text
destpadname = 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 Element
src' <- a -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
src
    Ptr CChar
srcpadname' <- Text -> IO (Ptr CChar)
textToCString Text
srcpadname
    Ptr Element
dest' <- b -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
dest
    Ptr CChar
destpadname' <- Text -> IO (Ptr CChar)
textToCString Text
destpadname
    Ptr Element -> Ptr CChar -> Ptr Element -> Ptr CChar -> IO ()
gst_element_unlink_pads Ptr Element
src' Ptr CChar
srcpadname' Ptr Element
dest' Ptr CChar
destpadname'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
src
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
dest
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
srcpadname'
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
destpadname'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ElementUnlinkPadsMethodInfo
instance (signature ~ (T.Text -> b -> T.Text -> m ()), MonadIO m, IsElement a, IsElement b) => O.OverloadedMethod ElementUnlinkPadsMethodInfo a signature where
    overloadedMethod = elementUnlinkPads

instance O.OverloadedMethodInfo ElementUnlinkPadsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.Element.elementUnlinkPads",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-Element.html#v:elementUnlinkPads"
        })


#endif

-- method Element::make_from_uri
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "type"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "URIType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Whether to create a source or a sink"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "uri"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "URI to create an element for"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "elementname"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Name of created element, can be %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Element" })
-- throws : True
-- Skip return : False

foreign import ccall "gst_element_make_from_uri" gst_element_make_from_uri :: 
    CUInt ->                                -- type : TInterface (Name {namespace = "Gst", name = "URIType"})
    CString ->                              -- uri : TBasicType TUTF8
    CString ->                              -- elementname : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Element)

-- | Creates an element for handling the given URI.
elementMakeFromUri ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Enums.URIType
    -- ^ /@type@/: Whether to create a source or a sink
    -> T.Text
    -- ^ /@uri@/: URI to create an element for
    -> Maybe (T.Text)
    -- ^ /@elementname@/: Name of created element, can be 'P.Nothing'.
    -> m Element
    -- ^ __Returns:__ a new element or 'P.Nothing' if none
    -- could be created /(Can throw 'Data.GI.Base.GError.GError')/
elementMakeFromUri :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
URIType -> Text -> Maybe Text -> m Element
elementMakeFromUri URIType
type_ Text
uri Maybe Text
elementname = IO Element -> m Element
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Element -> m Element) -> IO Element -> m Element
forall a b. (a -> b) -> a -> b
$ do
    let type_' :: CUInt
type_' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (URIType -> Int) -> URIType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URIType -> Int
forall a. Enum a => a -> Int
fromEnum) URIType
type_
    Ptr CChar
uri' <- Text -> IO (Ptr CChar)
textToCString Text
uri
    Ptr CChar
maybeElementname <- case Maybe Text
elementname of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jElementname -> do
            Ptr CChar
jElementname' <- Text -> IO (Ptr CChar)
textToCString Text
jElementname
            Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jElementname'
    IO Element -> IO () -> IO Element
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Element
result <- (Ptr (Ptr GError) -> IO (Ptr Element)) -> IO (Ptr Element)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Element)) -> IO (Ptr Element))
-> (Ptr (Ptr GError) -> IO (Ptr Element)) -> IO (Ptr Element)
forall a b. (a -> b) -> a -> b
$ CUInt
-> Ptr CChar -> Ptr CChar -> Ptr (Ptr GError) -> IO (Ptr Element)
gst_element_make_from_uri CUInt
type_' Ptr CChar
uri' Ptr CChar
maybeElementname
        Text -> Ptr Element -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"elementMakeFromUri" Ptr Element
result
        Element
result' <- ((ManagedPtr Element -> Element) -> Ptr Element -> IO Element
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Element -> Element
Element) Ptr Element
result
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
uri'
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeElementname
        Element -> IO Element
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Element
result'
     ) (do
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
uri'
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeElementname
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method Element::register
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "plugin"
--           , argType = TInterface Name { namespace = "Gst" , name = "Plugin" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "#GstPlugin to register the element with, or %NULL for\n    a static element."
--                 , 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 "name of elements of this type"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "rank"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "rank of element (higher rank means more importance when autoplugging)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "type"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "GType of element to register"
--                 , 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_element_register" gst_element_register :: 
    Ptr Gst.Plugin.Plugin ->                -- plugin : TInterface (Name {namespace = "Gst", name = "Plugin"})
    CString ->                              -- name : TBasicType TUTF8
    Word32 ->                               -- rank : TBasicType TUInt
    CGType ->                               -- type : TBasicType TGType
    IO CInt

-- | Create a new elementfactory capable of instantiating objects of the
-- /@type@/ and add the factory to /@plugin@/.
elementRegister ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Plugin.IsPlugin a) =>
    Maybe (a)
    -- ^ /@plugin@/: t'GI.Gst.Objects.Plugin.Plugin' to register the element with, or 'P.Nothing' for
    --     a static element.
    -> T.Text
    -- ^ /@name@/: name of elements of this type
    -> Word32
    -- ^ /@rank@/: rank of element (higher rank means more importance when autoplugging)
    -> GType
    -- ^ /@type@/: GType of element to register
    -> m Bool
    -- ^ __Returns:__ 'P.True', if the registering succeeded, 'P.False' on error
elementRegister :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPlugin a) =>
Maybe a -> Text -> Word32 -> GType -> m Bool
elementRegister Maybe a
plugin Text
name Word32
rank GType
type_ = 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 Plugin
maybePlugin <- case Maybe a
plugin of
        Maybe a
Nothing -> Ptr Plugin -> IO (Ptr Plugin)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Plugin
forall a. Ptr a
nullPtr
        Just a
jPlugin -> do
            Ptr Plugin
jPlugin' <- a -> IO (Ptr Plugin)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jPlugin
            Ptr Plugin -> IO (Ptr Plugin)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Plugin
jPlugin'
    Ptr CChar
name' <- Text -> IO (Ptr CChar)
textToCString Text
name
    let type_' :: Word64
type_' = GType -> Word64
gtypeToCGType GType
type_
    CInt
result <- Ptr Plugin -> Ptr CChar -> Word32 -> Word64 -> IO CInt
gst_element_register Ptr Plugin
maybePlugin Ptr CChar
name' Word32
rank Word64
type_'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
plugin a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
name'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Element::state_change_return_get_name
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "state_ret"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "StateChangeReturn" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStateChangeReturn to get the name of."
--                 , 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_element_state_change_return_get_name" gst_element_state_change_return_get_name :: 
    CUInt ->                                -- state_ret : TInterface (Name {namespace = "Gst", name = "StateChangeReturn"})
    IO CString

-- | Gets a string representing the given state change result.
elementStateChangeReturnGetName ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Enums.StateChangeReturn
    -- ^ /@stateRet@/: a t'GI.Gst.Enums.StateChangeReturn' to get the name of.
    -> m T.Text
    -- ^ __Returns:__ a string with the name of the state
    --    result.
elementStateChangeReturnGetName :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
StateChangeReturn -> m Text
elementStateChangeReturnGetName StateChangeReturn
stateRet = 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
    let stateRet' :: CUInt
stateRet' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (StateChangeReturn -> Int) -> StateChangeReturn -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateChangeReturn -> Int
forall a. Enum a => a -> Int
fromEnum) StateChangeReturn
stateRet
    Ptr CChar
result <- CUInt -> IO (Ptr CChar)
gst_element_state_change_return_get_name CUInt
stateRet'
    Text -> Ptr CChar -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"elementStateChangeReturnGetName" Ptr CChar
result
    Text
result' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Element::state_get_name
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "state"
--           , argType = TInterface Name { namespace = "Gst" , name = "State" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstState to get the name of."
--                 , 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_element_state_get_name" gst_element_state_get_name :: 
    CUInt ->                                -- state : TInterface (Name {namespace = "Gst", name = "State"})
    IO CString

-- | Gets a string representing the given state.
elementStateGetName ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Enums.State
    -- ^ /@state@/: a t'GI.Gst.Enums.State' to get the name of.
    -> m T.Text
    -- ^ __Returns:__ a string with the name of the state.
elementStateGetName :: forall (m :: * -> *). (HasCallStack, MonadIO m) => State -> m Text
elementStateGetName State
state = 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
    let state' :: CUInt
state' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (State -> Int) -> State -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> Int
forall a. Enum a => a -> Int
fromEnum) State
state
    Ptr CChar
result <- CUInt -> IO (Ptr CChar)
gst_element_state_get_name CUInt
state'
    Text -> Ptr CChar -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"elementStateGetName" Ptr CChar
result
    Text
result' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Element::type_set_skip_documentation
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "type"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GType of element"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_element_type_set_skip_documentation" gst_element_type_set_skip_documentation :: 
    CGType ->                               -- type : TBasicType TGType
    IO ()

-- | Marks /@type@/ as \"documentation should be skipped\".
-- Can be useful for dynamically registered element to be excluded from
-- plugin documentation system.
-- 
-- Example:
-- 
-- === /c code/
-- >GType my_type;
-- >GTypeInfo my_type_info;
-- >
-- >// Fill "my_type_info"
-- >...
-- >
-- >my_type = g_type_register_static (GST_TYPE_MY_ELEMENT, "my-type-name",
-- >   &my_type_info, 0);
-- >gst_element_type_set_skip_documentation (my_type);
-- >gst_element_register (plugin, "my-plugin-feature-name", rank, my_type);
-- 
-- 
-- /Since: 1.20/
elementTypeSetSkipDocumentation ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GType
    -- ^ /@type@/: a t'GType' of element
    -> m ()
elementTypeSetSkipDocumentation :: forall (m :: * -> *). (HasCallStack, MonadIO m) => GType -> m ()
elementTypeSetSkipDocumentation GType
type_ = 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
    let type_' :: Word64
type_' = GType -> Word64
gtypeToCGType GType
type_
    Word64 -> IO ()
gst_element_type_set_skip_documentation Word64
type_'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
#endif