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