{-# LANGUAGE TypeApplications #-}
#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif
module GI.GES.Objects.AudioUriSource
(
AudioUriSource(..) ,
IsAudioUriSource ,
toAudioUriSource ,
#if defined(ENABLE_OVERLOADING)
ResolveAudioUriSourceMethod ,
#endif
#if defined(ENABLE_OVERLOADING)
AudioUriSourceUriPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
audioUriSourceUri ,
#endif
constructAudioUriSourceUri ,
getAudioUriSourceUri ,
) where
import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P
import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R
import {-# SOURCE #-} qualified GI.GES.Interfaces.Extractable as GES.Extractable
import {-# SOURCE #-} qualified GI.GES.Interfaces.MetaContainer as GES.MetaContainer
import {-# SOURCE #-} qualified GI.GES.Objects.AudioSource as GES.AudioSource
import {-# SOURCE #-} qualified GI.GES.Objects.Source as GES.Source
import {-# SOURCE #-} qualified GI.GES.Objects.TimelineElement as GES.TimelineElement
import {-# SOURCE #-} qualified GI.GES.Objects.TrackElement as GES.TrackElement
import qualified GI.GObject.Objects.Object as GObject.Object
newtype AudioUriSource = AudioUriSource (SP.ManagedPtr AudioUriSource)
deriving (AudioUriSource -> AudioUriSource -> Bool
(AudioUriSource -> AudioUriSource -> Bool)
-> (AudioUriSource -> AudioUriSource -> Bool) -> Eq AudioUriSource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AudioUriSource -> AudioUriSource -> Bool
== :: AudioUriSource -> AudioUriSource -> Bool
$c/= :: AudioUriSource -> AudioUriSource -> Bool
/= :: AudioUriSource -> AudioUriSource -> Bool
Eq)
instance SP.ManagedPtrNewtype AudioUriSource where
toManagedPtr :: AudioUriSource -> ManagedPtr AudioUriSource
toManagedPtr (AudioUriSource ManagedPtr AudioUriSource
p) = ManagedPtr AudioUriSource
p
foreign import ccall "ges_audio_uri_source_get_type"
c_ges_audio_uri_source_get_type :: IO B.Types.GType
instance B.Types.TypedObject AudioUriSource where
glibType :: IO GType
glibType = IO GType
c_ges_audio_uri_source_get_type
instance B.Types.GObject AudioUriSource
class (SP.GObject o, O.IsDescendantOf AudioUriSource o) => IsAudioUriSource o
instance (SP.GObject o, O.IsDescendantOf AudioUriSource o) => IsAudioUriSource o
instance O.HasParentTypes AudioUriSource
type instance O.ParentTypes AudioUriSource = '[GES.AudioSource.AudioSource, GES.Source.Source, GES.TrackElement.TrackElement, GES.TimelineElement.TimelineElement, GObject.Object.Object, GES.Extractable.Extractable, GES.MetaContainer.MetaContainer]
toAudioUriSource :: (MIO.MonadIO m, IsAudioUriSource o) => o -> m AudioUriSource
toAudioUriSource :: forall (m :: * -> *) o.
(MonadIO m, IsAudioUriSource o) =>
o -> m AudioUriSource
toAudioUriSource = IO AudioUriSource -> m AudioUriSource
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO AudioUriSource -> m AudioUriSource)
-> (o -> IO AudioUriSource) -> o -> m AudioUriSource
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr AudioUriSource -> AudioUriSource)
-> o -> IO AudioUriSource
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr AudioUriSource -> AudioUriSource
AudioUriSource
instance B.GValue.IsGValue (Maybe AudioUriSource) where
gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_ges_audio_uri_source_get_type
gvalueSet_ :: Ptr GValue -> Maybe AudioUriSource -> IO ()
gvalueSet_ Ptr GValue
gv Maybe AudioUriSource
P.Nothing = Ptr GValue -> Ptr AudioUriSource -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr AudioUriSource
forall a. Ptr a
FP.nullPtr :: FP.Ptr AudioUriSource)
gvalueSet_ Ptr GValue
gv (P.Just AudioUriSource
obj) = AudioUriSource -> (Ptr AudioUriSource -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr AudioUriSource
obj (Ptr GValue -> Ptr AudioUriSource -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
gvalueGet_ :: Ptr GValue -> IO (Maybe AudioUriSource)
gvalueGet_ Ptr GValue
gv = do
Ptr AudioUriSource
ptr <- Ptr GValue -> IO (Ptr AudioUriSource)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr AudioUriSource)
if Ptr AudioUriSource
ptr Ptr AudioUriSource -> Ptr AudioUriSource -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr AudioUriSource
forall a. Ptr a
FP.nullPtr
then AudioUriSource -> Maybe AudioUriSource
forall a. a -> Maybe a
P.Just (AudioUriSource -> Maybe AudioUriSource)
-> IO AudioUriSource -> IO (Maybe AudioUriSource)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr AudioUriSource -> AudioUriSource)
-> Ptr AudioUriSource -> IO AudioUriSource
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr AudioUriSource -> AudioUriSource
AudioUriSource Ptr AudioUriSource
ptr
else Maybe AudioUriSource -> IO (Maybe AudioUriSource)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe AudioUriSource
forall a. Maybe a
P.Nothing
#if defined(ENABLE_OVERLOADING)
type family ResolveAudioUriSourceMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
ResolveAudioUriSourceMethod "addChildProperty" o = GES.TimelineElement.TimelineElementAddChildPropertyMethodInfo
ResolveAudioUriSourceMethod "addChildrenProps" o = GES.TrackElement.TrackElementAddChildrenPropsMethodInfo
ResolveAudioUriSourceMethod "addMetasFromString" o = GES.MetaContainer.MetaContainerAddMetasFromStringMethodInfo
ResolveAudioUriSourceMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
ResolveAudioUriSourceMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
ResolveAudioUriSourceMethod "checkMetaRegistered" o = GES.MetaContainer.MetaContainerCheckMetaRegisteredMethodInfo
ResolveAudioUriSourceMethod "clampControlSource" o = GES.TrackElement.TrackElementClampControlSourceMethodInfo
ResolveAudioUriSourceMethod "copy" o = GES.TimelineElement.TimelineElementCopyMethodInfo
ResolveAudioUriSourceMethod "edit" o = GES.TrackElement.TrackElementEditMethodInfo
ResolveAudioUriSourceMethod "editFull" o = GES.TimelineElement.TimelineElementEditFullMethodInfo
ResolveAudioUriSourceMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
ResolveAudioUriSourceMethod "foreach" o = GES.MetaContainer.MetaContainerForeachMethodInfo
ResolveAudioUriSourceMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
ResolveAudioUriSourceMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
ResolveAudioUriSourceMethod "hasInternalSource" o = GES.TrackElement.TrackElementHasInternalSourceMethodInfo
ResolveAudioUriSourceMethod "isActive" o = GES.TrackElement.TrackElementIsActiveMethodInfo
ResolveAudioUriSourceMethod "isCore" o = GES.TrackElement.TrackElementIsCoreMethodInfo
ResolveAudioUriSourceMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
ResolveAudioUriSourceMethod "listChildrenProperties" o = GES.TrackElement.TrackElementListChildrenPropertiesMethodInfo
ResolveAudioUriSourceMethod "lookupChild" o = GES.TrackElement.TrackElementLookupChildMethodInfo
ResolveAudioUriSourceMethod "metasToString" o = GES.MetaContainer.MetaContainerMetasToStringMethodInfo
ResolveAudioUriSourceMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
ResolveAudioUriSourceMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
ResolveAudioUriSourceMethod "paste" o = GES.TimelineElement.TimelineElementPasteMethodInfo
ResolveAudioUriSourceMethod "ref" o = GObject.Object.ObjectRefMethodInfo
ResolveAudioUriSourceMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
ResolveAudioUriSourceMethod "registerMeta" o = GES.MetaContainer.MetaContainerRegisterMetaMethodInfo
ResolveAudioUriSourceMethod "registerMetaBoolean" o = GES.MetaContainer.MetaContainerRegisterMetaBooleanMethodInfo
ResolveAudioUriSourceMethod "registerMetaDate" o = GES.MetaContainer.MetaContainerRegisterMetaDateMethodInfo
ResolveAudioUriSourceMethod "registerMetaDateTime" o = GES.MetaContainer.MetaContainerRegisterMetaDateTimeMethodInfo
ResolveAudioUriSourceMethod "registerMetaDouble" o = GES.MetaContainer.MetaContainerRegisterMetaDoubleMethodInfo
ResolveAudioUriSourceMethod "registerMetaFloat" o = GES.MetaContainer.MetaContainerRegisterMetaFloatMethodInfo
ResolveAudioUriSourceMethod "registerMetaInt" o = GES.MetaContainer.MetaContainerRegisterMetaIntMethodInfo
ResolveAudioUriSourceMethod "registerMetaInt64" o = GES.MetaContainer.MetaContainerRegisterMetaInt64MethodInfo
ResolveAudioUriSourceMethod "registerMetaString" o = GES.MetaContainer.MetaContainerRegisterMetaStringMethodInfo
ResolveAudioUriSourceMethod "registerMetaUint" o = GES.MetaContainer.MetaContainerRegisterMetaUintMethodInfo
ResolveAudioUriSourceMethod "registerMetaUint64" o = GES.MetaContainer.MetaContainerRegisterMetaUint64MethodInfo
ResolveAudioUriSourceMethod "registerStaticMeta" o = GES.MetaContainer.MetaContainerRegisterStaticMetaMethodInfo
ResolveAudioUriSourceMethod "removeChildProperty" o = GES.TimelineElement.TimelineElementRemoveChildPropertyMethodInfo
ResolveAudioUriSourceMethod "removeControlBinding" o = GES.TrackElement.TrackElementRemoveControlBindingMethodInfo
ResolveAudioUriSourceMethod "ripple" o = GES.TimelineElement.TimelineElementRippleMethodInfo
ResolveAudioUriSourceMethod "rippleEnd" o = GES.TimelineElement.TimelineElementRippleEndMethodInfo
ResolveAudioUriSourceMethod "rollEnd" o = GES.TimelineElement.TimelineElementRollEndMethodInfo
ResolveAudioUriSourceMethod "rollStart" o = GES.TimelineElement.TimelineElementRollStartMethodInfo
ResolveAudioUriSourceMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
ResolveAudioUriSourceMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
ResolveAudioUriSourceMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
ResolveAudioUriSourceMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
ResolveAudioUriSourceMethod "trim" o = GES.TimelineElement.TimelineElementTrimMethodInfo
ResolveAudioUriSourceMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
ResolveAudioUriSourceMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
ResolveAudioUriSourceMethod "getAllControlBindings" o = GES.TrackElement.TrackElementGetAllControlBindingsMethodInfo
ResolveAudioUriSourceMethod "getAsset" o = GES.Extractable.ExtractableGetAssetMethodInfo
ResolveAudioUriSourceMethod "getAutoClampControlSources" o = GES.TrackElement.TrackElementGetAutoClampControlSourcesMethodInfo
ResolveAudioUriSourceMethod "getBoolean" o = GES.MetaContainer.MetaContainerGetBooleanMethodInfo
ResolveAudioUriSourceMethod "getChildProperty" o = GES.TimelineElement.TimelineElementGetChildPropertyMethodInfo
ResolveAudioUriSourceMethod "getChildPropertyByPspec" o = GES.TimelineElement.TimelineElementGetChildPropertyByPspecMethodInfo
ResolveAudioUriSourceMethod "getControlBinding" o = GES.TrackElement.TrackElementGetControlBindingMethodInfo
ResolveAudioUriSourceMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
ResolveAudioUriSourceMethod "getDate" o = GES.MetaContainer.MetaContainerGetDateMethodInfo
ResolveAudioUriSourceMethod "getDateTime" o = GES.MetaContainer.MetaContainerGetDateTimeMethodInfo
ResolveAudioUriSourceMethod "getDouble" o = GES.MetaContainer.MetaContainerGetDoubleMethodInfo
ResolveAudioUriSourceMethod "getDuration" o = GES.TimelineElement.TimelineElementGetDurationMethodInfo
ResolveAudioUriSourceMethod "getElement" o = GES.TrackElement.TrackElementGetElementMethodInfo
ResolveAudioUriSourceMethod "getFloat" o = GES.MetaContainer.MetaContainerGetFloatMethodInfo
ResolveAudioUriSourceMethod "getGnlobject" o = GES.TrackElement.TrackElementGetGnlobjectMethodInfo
ResolveAudioUriSourceMethod "getId" o = GES.Extractable.ExtractableGetIdMethodInfo
ResolveAudioUriSourceMethod "getInpoint" o = GES.TimelineElement.TimelineElementGetInpointMethodInfo
ResolveAudioUriSourceMethod "getInt" o = GES.MetaContainer.MetaContainerGetIntMethodInfo
ResolveAudioUriSourceMethod "getInt64" o = GES.MetaContainer.MetaContainerGetInt64MethodInfo
ResolveAudioUriSourceMethod "getLayerPriority" o = GES.TimelineElement.TimelineElementGetLayerPriorityMethodInfo
ResolveAudioUriSourceMethod "getMarkerList" o = GES.MetaContainer.MetaContainerGetMarkerListMethodInfo
ResolveAudioUriSourceMethod "getMaxDuration" o = GES.TimelineElement.TimelineElementGetMaxDurationMethodInfo
ResolveAudioUriSourceMethod "getMeta" o = GES.MetaContainer.MetaContainerGetMetaMethodInfo
ResolveAudioUriSourceMethod "getName" o = GES.TimelineElement.TimelineElementGetNameMethodInfo
ResolveAudioUriSourceMethod "getNaturalFramerate" o = GES.TimelineElement.TimelineElementGetNaturalFramerateMethodInfo
ResolveAudioUriSourceMethod "getNleobject" o = GES.TrackElement.TrackElementGetNleobjectMethodInfo
ResolveAudioUriSourceMethod "getParent" o = GES.TimelineElement.TimelineElementGetParentMethodInfo
ResolveAudioUriSourceMethod "getPriority" o = GES.TimelineElement.TimelineElementGetPriorityMethodInfo
ResolveAudioUriSourceMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
ResolveAudioUriSourceMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
ResolveAudioUriSourceMethod "getStart" o = GES.TimelineElement.TimelineElementGetStartMethodInfo
ResolveAudioUriSourceMethod "getString" o = GES.MetaContainer.MetaContainerGetStringMethodInfo
ResolveAudioUriSourceMethod "getTimeline" o = GES.TimelineElement.TimelineElementGetTimelineMethodInfo
ResolveAudioUriSourceMethod "getToplevelParent" o = GES.TimelineElement.TimelineElementGetToplevelParentMethodInfo
ResolveAudioUriSourceMethod "getTrack" o = GES.TrackElement.TrackElementGetTrackMethodInfo
ResolveAudioUriSourceMethod "getTrackType" o = GES.TrackElement.TrackElementGetTrackTypeMethodInfo
ResolveAudioUriSourceMethod "getTrackTypes" o = GES.TimelineElement.TimelineElementGetTrackTypesMethodInfo
ResolveAudioUriSourceMethod "getUint" o = GES.MetaContainer.MetaContainerGetUintMethodInfo
ResolveAudioUriSourceMethod "getUint64" o = GES.MetaContainer.MetaContainerGetUint64MethodInfo
ResolveAudioUriSourceMethod "setActive" o = GES.TrackElement.TrackElementSetActiveMethodInfo
ResolveAudioUriSourceMethod "setAsset" o = GES.Extractable.ExtractableSetAssetMethodInfo
ResolveAudioUriSourceMethod "setAutoClampControlSources" o = GES.TrackElement.TrackElementSetAutoClampControlSourcesMethodInfo
ResolveAudioUriSourceMethod "setBoolean" o = GES.MetaContainer.MetaContainerSetBooleanMethodInfo
ResolveAudioUriSourceMethod "setChildProperty" o = GES.TimelineElement.TimelineElementSetChildPropertyMethodInfo
ResolveAudioUriSourceMethod "setChildPropertyByPspec" o = GES.TimelineElement.TimelineElementSetChildPropertyByPspecMethodInfo
ResolveAudioUriSourceMethod "setChildPropertyFull" o = GES.TimelineElement.TimelineElementSetChildPropertyFullMethodInfo
ResolveAudioUriSourceMethod "setControlSource" o = GES.TrackElement.TrackElementSetControlSourceMethodInfo
ResolveAudioUriSourceMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
ResolveAudioUriSourceMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
ResolveAudioUriSourceMethod "setDate" o = GES.MetaContainer.MetaContainerSetDateMethodInfo
ResolveAudioUriSourceMethod "setDateTime" o = GES.MetaContainer.MetaContainerSetDateTimeMethodInfo
ResolveAudioUriSourceMethod "setDouble" o = GES.MetaContainer.MetaContainerSetDoubleMethodInfo
ResolveAudioUriSourceMethod "setDuration" o = GES.TimelineElement.TimelineElementSetDurationMethodInfo
ResolveAudioUriSourceMethod "setFloat" o = GES.MetaContainer.MetaContainerSetFloatMethodInfo
ResolveAudioUriSourceMethod "setHasInternalSource" o = GES.TrackElement.TrackElementSetHasInternalSourceMethodInfo
ResolveAudioUriSourceMethod "setInpoint" o = GES.TimelineElement.TimelineElementSetInpointMethodInfo
ResolveAudioUriSourceMethod "setInt" o = GES.MetaContainer.MetaContainerSetIntMethodInfo
ResolveAudioUriSourceMethod "setInt64" o = GES.MetaContainer.MetaContainerSetInt64MethodInfo
ResolveAudioUriSourceMethod "setMarkerList" o = GES.MetaContainer.MetaContainerSetMarkerListMethodInfo
ResolveAudioUriSourceMethod "setMaxDuration" o = GES.TimelineElement.TimelineElementSetMaxDurationMethodInfo
ResolveAudioUriSourceMethod "setMeta" o = GES.MetaContainer.MetaContainerSetMetaMethodInfo
ResolveAudioUriSourceMethod "setName" o = GES.TimelineElement.TimelineElementSetNameMethodInfo
ResolveAudioUriSourceMethod "setParent" o = GES.TimelineElement.TimelineElementSetParentMethodInfo
ResolveAudioUriSourceMethod "setPriority" o = GES.TimelineElement.TimelineElementSetPriorityMethodInfo
ResolveAudioUriSourceMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
ResolveAudioUriSourceMethod "setStart" o = GES.TimelineElement.TimelineElementSetStartMethodInfo
ResolveAudioUriSourceMethod "setString" o = GES.MetaContainer.MetaContainerSetStringMethodInfo
ResolveAudioUriSourceMethod "setTimeline" o = GES.TimelineElement.TimelineElementSetTimelineMethodInfo
ResolveAudioUriSourceMethod "setTrackType" o = GES.TrackElement.TrackElementSetTrackTypeMethodInfo
ResolveAudioUriSourceMethod "setUint" o = GES.MetaContainer.MetaContainerSetUintMethodInfo
ResolveAudioUriSourceMethod "setUint64" o = GES.MetaContainer.MetaContainerSetUint64MethodInfo
ResolveAudioUriSourceMethod l o = O.MethodResolutionFailed l o
instance (info ~ ResolveAudioUriSourceMethod t AudioUriSource, O.OverloadedMethod info AudioUriSource p) => OL.IsLabel t (AudioUriSource -> 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 ~ ResolveAudioUriSourceMethod t AudioUriSource, O.OverloadedMethod info AudioUriSource p, R.HasField t AudioUriSource p) => R.HasField t AudioUriSource p where
getField = O.overloadedMethod @info
#endif
instance (info ~ ResolveAudioUriSourceMethod t AudioUriSource, O.OverloadedMethodInfo info AudioUriSource) => OL.IsLabel t (O.MethodProxy info AudioUriSource) where
#if MIN_VERSION_base(4,10,0)
fromLabel = O.MethodProxy
#else
fromLabel _ = O.MethodProxy
#endif
#endif
getAudioUriSourceUri :: (MonadIO m, IsAudioUriSource o) => o -> m (Maybe T.Text)
getAudioUriSourceUri :: forall (m :: * -> *) o.
(MonadIO m, IsAudioUriSource o) =>
o -> m (Maybe Text)
getAudioUriSourceUri o
obj = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"uri"
constructAudioUriSourceUri :: (IsAudioUriSource o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructAudioUriSourceUri :: forall o (m :: * -> *).
(IsAudioUriSource o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructAudioUriSourceUri Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"uri" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)
#if defined(ENABLE_OVERLOADING)
data AudioUriSourceUriPropertyInfo
instance AttrInfo AudioUriSourceUriPropertyInfo where
type AttrAllowedOps AudioUriSourceUriPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
type AttrBaseTypeConstraint AudioUriSourceUriPropertyInfo = IsAudioUriSource
type AttrSetTypeConstraint AudioUriSourceUriPropertyInfo = (~) T.Text
type AttrTransferTypeConstraint AudioUriSourceUriPropertyInfo = (~) T.Text
type AttrTransferType AudioUriSourceUriPropertyInfo = T.Text
type AttrGetType AudioUriSourceUriPropertyInfo = (Maybe T.Text)
type AttrLabel AudioUriSourceUriPropertyInfo = "uri"
type AttrOrigin AudioUriSourceUriPropertyInfo = AudioUriSource
attrGet = getAudioUriSourceUri
attrSet = undefined
attrTransfer _ v = do
return v
attrConstruct = constructAudioUriSourceUri
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.GES.Objects.AudioUriSource.uri"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Objects-AudioUriSource.html#g:attr:uri"
})
#endif
#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList AudioUriSource
type instance O.AttributeList AudioUriSource = AudioUriSourceAttributeList
type AudioUriSourceAttributeList = ('[ '("active", GES.TrackElement.TrackElementActivePropertyInfo), '("autoClampControlSources", GES.TrackElement.TrackElementAutoClampControlSourcesPropertyInfo), '("duration", GES.TimelineElement.TimelineElementDurationPropertyInfo), '("hasInternalSource", GES.TrackElement.TrackElementHasInternalSourcePropertyInfo), '("inPoint", GES.TimelineElement.TimelineElementInPointPropertyInfo), '("maxDuration", GES.TimelineElement.TimelineElementMaxDurationPropertyInfo), '("name", GES.TimelineElement.TimelineElementNamePropertyInfo), '("parent", GES.TimelineElement.TimelineElementParentPropertyInfo), '("priority", GES.TimelineElement.TimelineElementPriorityPropertyInfo), '("serialize", GES.TimelineElement.TimelineElementSerializePropertyInfo), '("start", GES.TimelineElement.TimelineElementStartPropertyInfo), '("timeline", GES.TimelineElement.TimelineElementTimelinePropertyInfo), '("track", GES.TrackElement.TrackElementTrackPropertyInfo), '("trackType", GES.TrackElement.TrackElementTrackTypePropertyInfo), '("uri", AudioUriSourceUriPropertyInfo)] :: [(Symbol, DK.Type)])
#endif
#if defined(ENABLE_OVERLOADING)
audioUriSourceUri :: AttrLabelProxy "uri"
audioUriSourceUri = AttrLabelProxy
#endif
#if defined(ENABLE_OVERLOADING)
type instance O.SignalList AudioUriSource = AudioUriSourceSignalList
type AudioUriSourceSignalList = ('[ '("childPropertyAdded", GES.TimelineElement.TimelineElementChildPropertyAddedSignalInfo), '("childPropertyRemoved", GES.TimelineElement.TimelineElementChildPropertyRemovedSignalInfo), '("controlBindingAdded", GES.TrackElement.TrackElementControlBindingAddedSignalInfo), '("controlBindingRemoved", GES.TrackElement.TrackElementControlBindingRemovedSignalInfo), '("deepNotify", GES.TimelineElement.TimelineElementDeepNotifySignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("notifyMeta", GES.MetaContainer.MetaContainerNotifyMetaSignalInfo)] :: [(Symbol, DK.Type)])
#endif