{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- t'GI.Gtk.Objects.MediaStream.MediaStream' is the integration point for media playback inside GTK.
-- 
-- Apart from application-facing API for stream playback, t'GI.Gtk.Objects.MediaStream.MediaStream'
-- has a number of APIs that are only useful for implementations and should
-- not be used in applications:
-- 'GI.Gtk.Objects.MediaStream.mediaStreamPrepared',
-- 'GI.Gtk.Objects.MediaStream.mediaStreamUnprepared',
-- 'GI.Gtk.Objects.MediaStream.mediaStreamUpdate',
-- 'GI.Gtk.Objects.MediaStream.mediaStreamEnded',
-- 'GI.Gtk.Objects.MediaStream.mediaStreamSeekSuccess',
-- 'GI.Gtk.Objects.MediaStream.mediaStreamSeekFailed',
-- 'GI.Gtk.Objects.MediaStream.mediaStreamGerror',
-- @/gtk_media_stream_error()/@,
-- @/gtk_media_stream_error_valist()/@.

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

module GI.Gtk.Objects.MediaStream
    ( 

-- * Exported types
    MediaStream(..)                         ,
    IsMediaStream                           ,
    toMediaStream                           ,
    noMediaStream                           ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveMediaStreamMethod                ,
#endif


-- ** ended #method:ended#

#if defined(ENABLE_OVERLOADING)
    MediaStreamEndedMethodInfo              ,
#endif
    mediaStreamEnded                        ,


-- ** gerror #method:gerror#

#if defined(ENABLE_OVERLOADING)
    MediaStreamGerrorMethodInfo             ,
#endif
    mediaStreamGerror                       ,


-- ** getDuration #method:getDuration#

#if defined(ENABLE_OVERLOADING)
    MediaStreamGetDurationMethodInfo        ,
#endif
    mediaStreamGetDuration                  ,


-- ** getEnded #method:getEnded#

#if defined(ENABLE_OVERLOADING)
    MediaStreamGetEndedMethodInfo           ,
#endif
    mediaStreamGetEnded                     ,


-- ** getError #method:getError#

#if defined(ENABLE_OVERLOADING)
    MediaStreamGetErrorMethodInfo           ,
#endif
    mediaStreamGetError                     ,


-- ** getLoop #method:getLoop#

#if defined(ENABLE_OVERLOADING)
    MediaStreamGetLoopMethodInfo            ,
#endif
    mediaStreamGetLoop                      ,


-- ** getMuted #method:getMuted#

#if defined(ENABLE_OVERLOADING)
    MediaStreamGetMutedMethodInfo           ,
#endif
    mediaStreamGetMuted                     ,


-- ** getPlaying #method:getPlaying#

#if defined(ENABLE_OVERLOADING)
    MediaStreamGetPlayingMethodInfo         ,
#endif
    mediaStreamGetPlaying                   ,


-- ** getTimestamp #method:getTimestamp#

#if defined(ENABLE_OVERLOADING)
    MediaStreamGetTimestampMethodInfo       ,
#endif
    mediaStreamGetTimestamp                 ,


-- ** getVolume #method:getVolume#

#if defined(ENABLE_OVERLOADING)
    MediaStreamGetVolumeMethodInfo          ,
#endif
    mediaStreamGetVolume                    ,


-- ** hasAudio #method:hasAudio#

#if defined(ENABLE_OVERLOADING)
    MediaStreamHasAudioMethodInfo           ,
#endif
    mediaStreamHasAudio                     ,


-- ** hasVideo #method:hasVideo#

#if defined(ENABLE_OVERLOADING)
    MediaStreamHasVideoMethodInfo           ,
#endif
    mediaStreamHasVideo                     ,


-- ** isPrepared #method:isPrepared#

#if defined(ENABLE_OVERLOADING)
    MediaStreamIsPreparedMethodInfo         ,
#endif
    mediaStreamIsPrepared                   ,


-- ** isSeekable #method:isSeekable#

#if defined(ENABLE_OVERLOADING)
    MediaStreamIsSeekableMethodInfo         ,
#endif
    mediaStreamIsSeekable                   ,


-- ** isSeeking #method:isSeeking#

#if defined(ENABLE_OVERLOADING)
    MediaStreamIsSeekingMethodInfo          ,
#endif
    mediaStreamIsSeeking                    ,


-- ** pause #method:pause#

#if defined(ENABLE_OVERLOADING)
    MediaStreamPauseMethodInfo              ,
#endif
    mediaStreamPause                        ,


-- ** play #method:play#

#if defined(ENABLE_OVERLOADING)
    MediaStreamPlayMethodInfo               ,
#endif
    mediaStreamPlay                         ,


-- ** prepared #method:prepared#

#if defined(ENABLE_OVERLOADING)
    MediaStreamPreparedMethodInfo           ,
#endif
    mediaStreamPrepared                     ,


-- ** realize #method:realize#

#if defined(ENABLE_OVERLOADING)
    MediaStreamRealizeMethodInfo            ,
#endif
    mediaStreamRealize                      ,


-- ** seek #method:seek#

#if defined(ENABLE_OVERLOADING)
    MediaStreamSeekMethodInfo               ,
#endif
    mediaStreamSeek                         ,


-- ** seekFailed #method:seekFailed#

#if defined(ENABLE_OVERLOADING)
    MediaStreamSeekFailedMethodInfo         ,
#endif
    mediaStreamSeekFailed                   ,


-- ** seekSuccess #method:seekSuccess#

#if defined(ENABLE_OVERLOADING)
    MediaStreamSeekSuccessMethodInfo        ,
#endif
    mediaStreamSeekSuccess                  ,


-- ** setLoop #method:setLoop#

#if defined(ENABLE_OVERLOADING)
    MediaStreamSetLoopMethodInfo            ,
#endif
    mediaStreamSetLoop                      ,


-- ** setMuted #method:setMuted#

#if defined(ENABLE_OVERLOADING)
    MediaStreamSetMutedMethodInfo           ,
#endif
    mediaStreamSetMuted                     ,


-- ** setPlaying #method:setPlaying#

#if defined(ENABLE_OVERLOADING)
    MediaStreamSetPlayingMethodInfo         ,
#endif
    mediaStreamSetPlaying                   ,


-- ** setVolume #method:setVolume#

#if defined(ENABLE_OVERLOADING)
    MediaStreamSetVolumeMethodInfo          ,
#endif
    mediaStreamSetVolume                    ,


-- ** unprepared #method:unprepared#

#if defined(ENABLE_OVERLOADING)
    MediaStreamUnpreparedMethodInfo         ,
#endif
    mediaStreamUnprepared                   ,


-- ** unrealize #method:unrealize#

#if defined(ENABLE_OVERLOADING)
    MediaStreamUnrealizeMethodInfo          ,
#endif
    mediaStreamUnrealize                    ,


-- ** update #method:update#

#if defined(ENABLE_OVERLOADING)
    MediaStreamUpdateMethodInfo             ,
#endif
    mediaStreamUpdate                       ,




 -- * Properties
-- ** duration #attr:duration#
-- | The stream\'s duration in microseconds or 0 if unknown.

#if defined(ENABLE_OVERLOADING)
    MediaStreamDurationPropertyInfo         ,
#endif
    getMediaStreamDuration                  ,
#if defined(ENABLE_OVERLOADING)
    mediaStreamDuration                     ,
#endif


-- ** ended #attr:ended#
-- | Set when playback has finished.

#if defined(ENABLE_OVERLOADING)
    MediaStreamEndedPropertyInfo            ,
#endif
    getMediaStreamEnded                     ,


-- ** error #attr:error#
-- | 'P.Nothing' for a properly working stream or the t'GError' that the stream is in.

#if defined(ENABLE_OVERLOADING)
    MediaStreamErrorPropertyInfo            ,
#endif
    clearMediaStreamError                   ,
    constructMediaStreamError               ,
    getMediaStreamError                     ,
#if defined(ENABLE_OVERLOADING)
    mediaStreamError                        ,
#endif
    setMediaStreamError                     ,


-- ** hasAudio #attr:hasAudio#
-- | Whether the stream contains audio

#if defined(ENABLE_OVERLOADING)
    MediaStreamHasAudioPropertyInfo         ,
#endif
    constructMediaStreamHasAudio            ,
    getMediaStreamHasAudio                  ,
    setMediaStreamHasAudio                  ,


-- ** hasVideo #attr:hasVideo#
-- | Whether the stream contains video

#if defined(ENABLE_OVERLOADING)
    MediaStreamHasVideoPropertyInfo         ,
#endif
    constructMediaStreamHasVideo            ,
    getMediaStreamHasVideo                  ,
    setMediaStreamHasVideo                  ,


-- ** loop #attr:loop#
-- | Try to restart the media from the beginning once it ended.

#if defined(ENABLE_OVERLOADING)
    MediaStreamLoopPropertyInfo             ,
#endif
    constructMediaStreamLoop                ,
    getMediaStreamLoop                      ,
#if defined(ENABLE_OVERLOADING)
    mediaStreamLoop                         ,
#endif
    setMediaStreamLoop                      ,


-- ** muted #attr:muted#
-- | Whether the audio stream should be muted.

#if defined(ENABLE_OVERLOADING)
    MediaStreamMutedPropertyInfo            ,
#endif
    constructMediaStreamMuted               ,
    getMediaStreamMuted                     ,
#if defined(ENABLE_OVERLOADING)
    mediaStreamMuted                        ,
#endif
    setMediaStreamMuted                     ,


-- ** playing #attr:playing#
-- | Whether the stream is currently playing.

#if defined(ENABLE_OVERLOADING)
    MediaStreamPlayingPropertyInfo          ,
#endif
    constructMediaStreamPlaying             ,
    getMediaStreamPlaying                   ,
#if defined(ENABLE_OVERLOADING)
    mediaStreamPlaying                      ,
#endif
    setMediaStreamPlaying                   ,


-- ** prepared #attr:prepared#
-- | Whether the stream has finished initializing and existence of
-- audio and video is known.

#if defined(ENABLE_OVERLOADING)
    MediaStreamPreparedPropertyInfo         ,
#endif
    constructMediaStreamPrepared            ,
    getMediaStreamPrepared                  ,
    setMediaStreamPrepared                  ,


-- ** seekable #attr:seekable#
-- | Set unless the stream is known to not support seeking.

#if defined(ENABLE_OVERLOADING)
    MediaStreamSeekablePropertyInfo         ,
#endif
    getMediaStreamSeekable                  ,
#if defined(ENABLE_OVERLOADING)
    mediaStreamSeekable                     ,
#endif


-- ** seeking #attr:seeking#
-- | Set while a seek is in progress.

#if defined(ENABLE_OVERLOADING)
    MediaStreamSeekingPropertyInfo          ,
#endif
    getMediaStreamSeeking                   ,
#if defined(ENABLE_OVERLOADING)
    mediaStreamSeeking                      ,
#endif


-- ** timestamp #attr:timestamp#
-- | The current presentation timestamp in microseconds.

#if defined(ENABLE_OVERLOADING)
    MediaStreamTimestampPropertyInfo        ,
#endif
    getMediaStreamTimestamp                 ,
#if defined(ENABLE_OVERLOADING)
    mediaStreamTimestamp                    ,
#endif


-- ** volume #attr:volume#
-- | Volume of the audio stream.

#if defined(ENABLE_OVERLOADING)
    MediaStreamVolumePropertyInfo           ,
#endif
    constructMediaStreamVolume              ,
    getMediaStreamVolume                    ,
#if defined(ENABLE_OVERLOADING)
    mediaStreamVolume                       ,
#endif
    setMediaStreamVolume                    ,




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gdk.Interfaces.Paintable as Gdk.Paintable
import qualified GI.Gdk.Objects.Surface as Gdk.Surface

-- | Memory-managed wrapper type.
newtype MediaStream = MediaStream (ManagedPtr MediaStream)
    deriving (MediaStream -> MediaStream -> Bool
(MediaStream -> MediaStream -> Bool)
-> (MediaStream -> MediaStream -> Bool) -> Eq MediaStream
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MediaStream -> MediaStream -> Bool
$c/= :: MediaStream -> MediaStream -> Bool
== :: MediaStream -> MediaStream -> Bool
$c== :: MediaStream -> MediaStream -> Bool
Eq)
foreign import ccall "gtk_media_stream_get_type"
    c_gtk_media_stream_get_type :: IO GType

instance GObject MediaStream where
    gobjectType :: IO GType
gobjectType = IO GType
c_gtk_media_stream_get_type
    

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

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

instance O.HasParentTypes MediaStream
type instance O.ParentTypes MediaStream = '[GObject.Object.Object, Gdk.Paintable.Paintable]

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

-- | A convenience alias for `Nothing` :: `Maybe` `MediaStream`.
noMediaStream :: Maybe MediaStream
noMediaStream :: Maybe MediaStream
noMediaStream = Maybe MediaStream
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolveMediaStreamMethod (t :: Symbol) (o :: *) :: * where
    ResolveMediaStreamMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveMediaStreamMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveMediaStreamMethod "computeConcreteSize" o = Gdk.Paintable.PaintableComputeConcreteSizeMethodInfo
    ResolveMediaStreamMethod "ended" o = MediaStreamEndedMethodInfo
    ResolveMediaStreamMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveMediaStreamMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveMediaStreamMethod "gerror" o = MediaStreamGerrorMethodInfo
    ResolveMediaStreamMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveMediaStreamMethod "hasAudio" o = MediaStreamHasAudioMethodInfo
    ResolveMediaStreamMethod "hasVideo" o = MediaStreamHasVideoMethodInfo
    ResolveMediaStreamMethod "invalidateContents" o = Gdk.Paintable.PaintableInvalidateContentsMethodInfo
    ResolveMediaStreamMethod "invalidateSize" o = Gdk.Paintable.PaintableInvalidateSizeMethodInfo
    ResolveMediaStreamMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveMediaStreamMethod "isPrepared" o = MediaStreamIsPreparedMethodInfo
    ResolveMediaStreamMethod "isSeekable" o = MediaStreamIsSeekableMethodInfo
    ResolveMediaStreamMethod "isSeeking" o = MediaStreamIsSeekingMethodInfo
    ResolveMediaStreamMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveMediaStreamMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveMediaStreamMethod "pause" o = MediaStreamPauseMethodInfo
    ResolveMediaStreamMethod "play" o = MediaStreamPlayMethodInfo
    ResolveMediaStreamMethod "prepared" o = MediaStreamPreparedMethodInfo
    ResolveMediaStreamMethod "realize" o = MediaStreamRealizeMethodInfo
    ResolveMediaStreamMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveMediaStreamMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveMediaStreamMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveMediaStreamMethod "seek" o = MediaStreamSeekMethodInfo
    ResolveMediaStreamMethod "seekFailed" o = MediaStreamSeekFailedMethodInfo
    ResolveMediaStreamMethod "seekSuccess" o = MediaStreamSeekSuccessMethodInfo
    ResolveMediaStreamMethod "snapshot" o = Gdk.Paintable.PaintableSnapshotMethodInfo
    ResolveMediaStreamMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveMediaStreamMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveMediaStreamMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveMediaStreamMethod "unprepared" o = MediaStreamUnpreparedMethodInfo
    ResolveMediaStreamMethod "unrealize" o = MediaStreamUnrealizeMethodInfo
    ResolveMediaStreamMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveMediaStreamMethod "update" o = MediaStreamUpdateMethodInfo
    ResolveMediaStreamMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveMediaStreamMethod "getCurrentImage" o = Gdk.Paintable.PaintableGetCurrentImageMethodInfo
    ResolveMediaStreamMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveMediaStreamMethod "getDuration" o = MediaStreamGetDurationMethodInfo
    ResolveMediaStreamMethod "getEnded" o = MediaStreamGetEndedMethodInfo
    ResolveMediaStreamMethod "getError" o = MediaStreamGetErrorMethodInfo
    ResolveMediaStreamMethod "getFlags" o = Gdk.Paintable.PaintableGetFlagsMethodInfo
    ResolveMediaStreamMethod "getIntrinsicAspectRatio" o = Gdk.Paintable.PaintableGetIntrinsicAspectRatioMethodInfo
    ResolveMediaStreamMethod "getIntrinsicHeight" o = Gdk.Paintable.PaintableGetIntrinsicHeightMethodInfo
    ResolveMediaStreamMethod "getIntrinsicWidth" o = Gdk.Paintable.PaintableGetIntrinsicWidthMethodInfo
    ResolveMediaStreamMethod "getLoop" o = MediaStreamGetLoopMethodInfo
    ResolveMediaStreamMethod "getMuted" o = MediaStreamGetMutedMethodInfo
    ResolveMediaStreamMethod "getPlaying" o = MediaStreamGetPlayingMethodInfo
    ResolveMediaStreamMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveMediaStreamMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveMediaStreamMethod "getTimestamp" o = MediaStreamGetTimestampMethodInfo
    ResolveMediaStreamMethod "getVolume" o = MediaStreamGetVolumeMethodInfo
    ResolveMediaStreamMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveMediaStreamMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveMediaStreamMethod "setLoop" o = MediaStreamSetLoopMethodInfo
    ResolveMediaStreamMethod "setMuted" o = MediaStreamSetMutedMethodInfo
    ResolveMediaStreamMethod "setPlaying" o = MediaStreamSetPlayingMethodInfo
    ResolveMediaStreamMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveMediaStreamMethod "setVolume" o = MediaStreamSetVolumeMethodInfo
    ResolveMediaStreamMethod l o = O.MethodResolutionFailed l o

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

#endif

-- VVV Prop "duration"
   -- Type: TBasicType TInt64
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@duration@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' mediaStream #duration
-- @
getMediaStreamDuration :: (MonadIO m, IsMediaStream o) => o -> m Int64
getMediaStreamDuration :: o -> m Int64
getMediaStreamDuration obj :: o
obj = IO Int64 -> m Int64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int64 -> m Int64) -> IO Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Int64
forall a. GObject a => a -> String -> IO Int64
B.Properties.getObjectPropertyInt64 o
obj "duration"

#if defined(ENABLE_OVERLOADING)
data MediaStreamDurationPropertyInfo
instance AttrInfo MediaStreamDurationPropertyInfo where
    type AttrAllowedOps MediaStreamDurationPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint MediaStreamDurationPropertyInfo = IsMediaStream
    type AttrSetTypeConstraint MediaStreamDurationPropertyInfo = (~) ()
    type AttrTransferTypeConstraint MediaStreamDurationPropertyInfo = (~) ()
    type AttrTransferType MediaStreamDurationPropertyInfo = ()
    type AttrGetType MediaStreamDurationPropertyInfo = Int64
    type AttrLabel MediaStreamDurationPropertyInfo = "duration"
    type AttrOrigin MediaStreamDurationPropertyInfo = MediaStream
    attrGet = getMediaStreamDuration
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

-- VVV Prop "ended"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@ended@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' mediaStream #ended
-- @
getMediaStreamEnded :: (MonadIO m, IsMediaStream o) => o -> m Bool
getMediaStreamEnded :: o -> m Bool
getMediaStreamEnded obj :: o
obj = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj "ended"

#if defined(ENABLE_OVERLOADING)
data MediaStreamEndedPropertyInfo
instance AttrInfo MediaStreamEndedPropertyInfo where
    type AttrAllowedOps MediaStreamEndedPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint MediaStreamEndedPropertyInfo = IsMediaStream
    type AttrSetTypeConstraint MediaStreamEndedPropertyInfo = (~) ()
    type AttrTransferTypeConstraint MediaStreamEndedPropertyInfo = (~) ()
    type AttrTransferType MediaStreamEndedPropertyInfo = ()
    type AttrGetType MediaStreamEndedPropertyInfo = Bool
    type AttrLabel MediaStreamEndedPropertyInfo = "ended"
    type AttrOrigin MediaStreamEndedPropertyInfo = MediaStream
    attrGet = getMediaStreamEnded
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

-- VVV Prop "error"
   -- Type: TError
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just True,Nothing)

-- | Get the value of the “@error@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' mediaStream #error
-- @
getMediaStreamError :: (MonadIO m, IsMediaStream o) => o -> m (Maybe GError)
getMediaStreamError :: o -> m (Maybe GError)
getMediaStreamError obj :: o
obj = IO (Maybe GError) -> m (Maybe GError)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe GError) -> m (Maybe GError))
-> IO (Maybe GError) -> m (Maybe GError)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe GError)
forall a. GObject a => a -> String -> IO (Maybe GError)
B.Properties.getObjectPropertyGError o
obj "error"

-- | Set the value of the “@error@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' mediaStream [ #error 'Data.GI.Base.Attributes.:=' value ]
-- @
setMediaStreamError :: (MonadIO m, IsMediaStream o) => o -> GError -> m ()
setMediaStreamError :: o -> GError -> m ()
setMediaStreamError obj :: o
obj val :: GError
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe GError -> IO ()
forall a. GObject a => a -> String -> Maybe GError -> IO ()
B.Properties.setObjectPropertyGError o
obj "error" (GError -> Maybe GError
forall a. a -> Maybe a
Just GError
val)

-- | Construct a `GValueConstruct` with valid value for the “@error@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructMediaStreamError :: (IsMediaStream o) => GError -> IO (GValueConstruct o)
constructMediaStreamError :: GError -> IO (GValueConstruct o)
constructMediaStreamError val :: GError
val = String -> Maybe GError -> IO (GValueConstruct o)
forall o. String -> Maybe GError -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyGError "error" (GError -> Maybe GError
forall a. a -> Maybe a
Just GError
val)

-- | Set the value of the “@error@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #error
-- @
clearMediaStreamError :: (MonadIO m, IsMediaStream o) => o -> m ()
clearMediaStreamError :: o -> m ()
clearMediaStreamError obj :: o
obj = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe GError -> IO ()
forall a. GObject a => a -> String -> Maybe GError -> IO ()
B.Properties.setObjectPropertyGError o
obj "error" (Maybe GError
forall a. Maybe a
Nothing :: Maybe GError)

#if defined(ENABLE_OVERLOADING)
data MediaStreamErrorPropertyInfo
instance AttrInfo MediaStreamErrorPropertyInfo where
    type AttrAllowedOps MediaStreamErrorPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint MediaStreamErrorPropertyInfo = IsMediaStream
    type AttrSetTypeConstraint MediaStreamErrorPropertyInfo = (~) GError
    type AttrTransferTypeConstraint MediaStreamErrorPropertyInfo = (~) GError
    type AttrTransferType MediaStreamErrorPropertyInfo = GError
    type AttrGetType MediaStreamErrorPropertyInfo = (Maybe GError)
    type AttrLabel MediaStreamErrorPropertyInfo = "error"
    type AttrOrigin MediaStreamErrorPropertyInfo = MediaStream
    attrGet = getMediaStreamError
    attrSet = setMediaStreamError
    attrTransfer _ v = do
        return v
    attrConstruct = constructMediaStreamError
    attrClear = clearMediaStreamError
#endif

-- VVV Prop "has-audio"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@has-audio@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' mediaStream #hasAudio
-- @
getMediaStreamHasAudio :: (MonadIO m, IsMediaStream o) => o -> m Bool
getMediaStreamHasAudio :: o -> m Bool
getMediaStreamHasAudio obj :: o
obj = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj "has-audio"

-- | Set the value of the “@has-audio@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' mediaStream [ #hasAudio 'Data.GI.Base.Attributes.:=' value ]
-- @
setMediaStreamHasAudio :: (MonadIO m, IsMediaStream o) => o -> Bool -> m ()
setMediaStreamHasAudio :: o -> Bool -> m ()
setMediaStreamHasAudio obj :: o
obj val :: Bool
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj "has-audio" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@has-audio@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructMediaStreamHasAudio :: (IsMediaStream o) => Bool -> IO (GValueConstruct o)
constructMediaStreamHasAudio :: Bool -> IO (GValueConstruct o)
constructMediaStreamHasAudio val :: Bool
val = String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool "has-audio" Bool
val

#if defined(ENABLE_OVERLOADING)
data MediaStreamHasAudioPropertyInfo
instance AttrInfo MediaStreamHasAudioPropertyInfo where
    type AttrAllowedOps MediaStreamHasAudioPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint MediaStreamHasAudioPropertyInfo = IsMediaStream
    type AttrSetTypeConstraint MediaStreamHasAudioPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint MediaStreamHasAudioPropertyInfo = (~) Bool
    type AttrTransferType MediaStreamHasAudioPropertyInfo = Bool
    type AttrGetType MediaStreamHasAudioPropertyInfo = Bool
    type AttrLabel MediaStreamHasAudioPropertyInfo = "has-audio"
    type AttrOrigin MediaStreamHasAudioPropertyInfo = MediaStream
    attrGet = getMediaStreamHasAudio
    attrSet = setMediaStreamHasAudio
    attrTransfer _ v = do
        return v
    attrConstruct = constructMediaStreamHasAudio
    attrClear = undefined
#endif

-- VVV Prop "has-video"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@has-video@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' mediaStream #hasVideo
-- @
getMediaStreamHasVideo :: (MonadIO m, IsMediaStream o) => o -> m Bool
getMediaStreamHasVideo :: o -> m Bool
getMediaStreamHasVideo obj :: o
obj = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj "has-video"

-- | Set the value of the “@has-video@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' mediaStream [ #hasVideo 'Data.GI.Base.Attributes.:=' value ]
-- @
setMediaStreamHasVideo :: (MonadIO m, IsMediaStream o) => o -> Bool -> m ()
setMediaStreamHasVideo :: o -> Bool -> m ()
setMediaStreamHasVideo obj :: o
obj val :: Bool
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj "has-video" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@has-video@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructMediaStreamHasVideo :: (IsMediaStream o) => Bool -> IO (GValueConstruct o)
constructMediaStreamHasVideo :: Bool -> IO (GValueConstruct o)
constructMediaStreamHasVideo val :: Bool
val = String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool "has-video" Bool
val

#if defined(ENABLE_OVERLOADING)
data MediaStreamHasVideoPropertyInfo
instance AttrInfo MediaStreamHasVideoPropertyInfo where
    type AttrAllowedOps MediaStreamHasVideoPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint MediaStreamHasVideoPropertyInfo = IsMediaStream
    type AttrSetTypeConstraint MediaStreamHasVideoPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint MediaStreamHasVideoPropertyInfo = (~) Bool
    type AttrTransferType MediaStreamHasVideoPropertyInfo = Bool
    type AttrGetType MediaStreamHasVideoPropertyInfo = Bool
    type AttrLabel MediaStreamHasVideoPropertyInfo = "has-video"
    type AttrOrigin MediaStreamHasVideoPropertyInfo = MediaStream
    attrGet = getMediaStreamHasVideo
    attrSet = setMediaStreamHasVideo
    attrTransfer _ v = do
        return v
    attrConstruct = constructMediaStreamHasVideo
    attrClear = undefined
#endif

-- VVV Prop "loop"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@loop@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' mediaStream #loop
-- @
getMediaStreamLoop :: (MonadIO m, IsMediaStream o) => o -> m Bool
getMediaStreamLoop :: o -> m Bool
getMediaStreamLoop obj :: o
obj = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj "loop"

-- | Set the value of the “@loop@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' mediaStream [ #loop 'Data.GI.Base.Attributes.:=' value ]
-- @
setMediaStreamLoop :: (MonadIO m, IsMediaStream o) => o -> Bool -> m ()
setMediaStreamLoop :: o -> Bool -> m ()
setMediaStreamLoop obj :: o
obj val :: Bool
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj "loop" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@loop@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructMediaStreamLoop :: (IsMediaStream o) => Bool -> IO (GValueConstruct o)
constructMediaStreamLoop :: Bool -> IO (GValueConstruct o)
constructMediaStreamLoop val :: Bool
val = String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool "loop" Bool
val

#if defined(ENABLE_OVERLOADING)
data MediaStreamLoopPropertyInfo
instance AttrInfo MediaStreamLoopPropertyInfo where
    type AttrAllowedOps MediaStreamLoopPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint MediaStreamLoopPropertyInfo = IsMediaStream
    type AttrSetTypeConstraint MediaStreamLoopPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint MediaStreamLoopPropertyInfo = (~) Bool
    type AttrTransferType MediaStreamLoopPropertyInfo = Bool
    type AttrGetType MediaStreamLoopPropertyInfo = Bool
    type AttrLabel MediaStreamLoopPropertyInfo = "loop"
    type AttrOrigin MediaStreamLoopPropertyInfo = MediaStream
    attrGet = getMediaStreamLoop
    attrSet = setMediaStreamLoop
    attrTransfer _ v = do
        return v
    attrConstruct = constructMediaStreamLoop
    attrClear = undefined
#endif

-- VVV Prop "muted"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@muted@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' mediaStream #muted
-- @
getMediaStreamMuted :: (MonadIO m, IsMediaStream o) => o -> m Bool
getMediaStreamMuted :: o -> m Bool
getMediaStreamMuted obj :: o
obj = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj "muted"

-- | Set the value of the “@muted@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' mediaStream [ #muted 'Data.GI.Base.Attributes.:=' value ]
-- @
setMediaStreamMuted :: (MonadIO m, IsMediaStream o) => o -> Bool -> m ()
setMediaStreamMuted :: o -> Bool -> m ()
setMediaStreamMuted obj :: o
obj val :: Bool
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj "muted" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@muted@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructMediaStreamMuted :: (IsMediaStream o) => Bool -> IO (GValueConstruct o)
constructMediaStreamMuted :: Bool -> IO (GValueConstruct o)
constructMediaStreamMuted val :: Bool
val = String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool "muted" Bool
val

#if defined(ENABLE_OVERLOADING)
data MediaStreamMutedPropertyInfo
instance AttrInfo MediaStreamMutedPropertyInfo where
    type AttrAllowedOps MediaStreamMutedPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint MediaStreamMutedPropertyInfo = IsMediaStream
    type AttrSetTypeConstraint MediaStreamMutedPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint MediaStreamMutedPropertyInfo = (~) Bool
    type AttrTransferType MediaStreamMutedPropertyInfo = Bool
    type AttrGetType MediaStreamMutedPropertyInfo = Bool
    type AttrLabel MediaStreamMutedPropertyInfo = "muted"
    type AttrOrigin MediaStreamMutedPropertyInfo = MediaStream
    attrGet = getMediaStreamMuted
    attrSet = setMediaStreamMuted
    attrTransfer _ v = do
        return v
    attrConstruct = constructMediaStreamMuted
    attrClear = undefined
#endif

-- VVV Prop "playing"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@playing@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' mediaStream #playing
-- @
getMediaStreamPlaying :: (MonadIO m, IsMediaStream o) => o -> m Bool
getMediaStreamPlaying :: o -> m Bool
getMediaStreamPlaying obj :: o
obj = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj "playing"

-- | Set the value of the “@playing@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' mediaStream [ #playing 'Data.GI.Base.Attributes.:=' value ]
-- @
setMediaStreamPlaying :: (MonadIO m, IsMediaStream o) => o -> Bool -> m ()
setMediaStreamPlaying :: o -> Bool -> m ()
setMediaStreamPlaying obj :: o
obj val :: Bool
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj "playing" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@playing@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructMediaStreamPlaying :: (IsMediaStream o) => Bool -> IO (GValueConstruct o)
constructMediaStreamPlaying :: Bool -> IO (GValueConstruct o)
constructMediaStreamPlaying val :: Bool
val = String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool "playing" Bool
val

#if defined(ENABLE_OVERLOADING)
data MediaStreamPlayingPropertyInfo
instance AttrInfo MediaStreamPlayingPropertyInfo where
    type AttrAllowedOps MediaStreamPlayingPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint MediaStreamPlayingPropertyInfo = IsMediaStream
    type AttrSetTypeConstraint MediaStreamPlayingPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint MediaStreamPlayingPropertyInfo = (~) Bool
    type AttrTransferType MediaStreamPlayingPropertyInfo = Bool
    type AttrGetType MediaStreamPlayingPropertyInfo = Bool
    type AttrLabel MediaStreamPlayingPropertyInfo = "playing"
    type AttrOrigin MediaStreamPlayingPropertyInfo = MediaStream
    attrGet = getMediaStreamPlaying
    attrSet = setMediaStreamPlaying
    attrTransfer _ v = do
        return v
    attrConstruct = constructMediaStreamPlaying
    attrClear = undefined
#endif

-- VVV Prop "prepared"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@prepared@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' mediaStream #prepared
-- @
getMediaStreamPrepared :: (MonadIO m, IsMediaStream o) => o -> m Bool
getMediaStreamPrepared :: o -> m Bool
getMediaStreamPrepared obj :: o
obj = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj "prepared"

-- | Set the value of the “@prepared@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' mediaStream [ #prepared 'Data.GI.Base.Attributes.:=' value ]
-- @
setMediaStreamPrepared :: (MonadIO m, IsMediaStream o) => o -> Bool -> m ()
setMediaStreamPrepared :: o -> Bool -> m ()
setMediaStreamPrepared obj :: o
obj val :: Bool
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj "prepared" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@prepared@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructMediaStreamPrepared :: (IsMediaStream o) => Bool -> IO (GValueConstruct o)
constructMediaStreamPrepared :: Bool -> IO (GValueConstruct o)
constructMediaStreamPrepared val :: Bool
val = String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool "prepared" Bool
val

#if defined(ENABLE_OVERLOADING)
data MediaStreamPreparedPropertyInfo
instance AttrInfo MediaStreamPreparedPropertyInfo where
    type AttrAllowedOps MediaStreamPreparedPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint MediaStreamPreparedPropertyInfo = IsMediaStream
    type AttrSetTypeConstraint MediaStreamPreparedPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint MediaStreamPreparedPropertyInfo = (~) Bool
    type AttrTransferType MediaStreamPreparedPropertyInfo = Bool
    type AttrGetType MediaStreamPreparedPropertyInfo = Bool
    type AttrLabel MediaStreamPreparedPropertyInfo = "prepared"
    type AttrOrigin MediaStreamPreparedPropertyInfo = MediaStream
    attrGet = getMediaStreamPrepared
    attrSet = setMediaStreamPrepared
    attrTransfer _ v = do
        return v
    attrConstruct = constructMediaStreamPrepared
    attrClear = undefined
#endif

-- VVV Prop "seekable"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@seekable@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' mediaStream #seekable
-- @
getMediaStreamSeekable :: (MonadIO m, IsMediaStream o) => o -> m Bool
getMediaStreamSeekable :: o -> m Bool
getMediaStreamSeekable obj :: o
obj = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj "seekable"

#if defined(ENABLE_OVERLOADING)
data MediaStreamSeekablePropertyInfo
instance AttrInfo MediaStreamSeekablePropertyInfo where
    type AttrAllowedOps MediaStreamSeekablePropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint MediaStreamSeekablePropertyInfo = IsMediaStream
    type AttrSetTypeConstraint MediaStreamSeekablePropertyInfo = (~) ()
    type AttrTransferTypeConstraint MediaStreamSeekablePropertyInfo = (~) ()
    type AttrTransferType MediaStreamSeekablePropertyInfo = ()
    type AttrGetType MediaStreamSeekablePropertyInfo = Bool
    type AttrLabel MediaStreamSeekablePropertyInfo = "seekable"
    type AttrOrigin MediaStreamSeekablePropertyInfo = MediaStream
    attrGet = getMediaStreamSeekable
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

-- VVV Prop "seeking"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@seeking@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' mediaStream #seeking
-- @
getMediaStreamSeeking :: (MonadIO m, IsMediaStream o) => o -> m Bool
getMediaStreamSeeking :: o -> m Bool
getMediaStreamSeeking obj :: o
obj = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj "seeking"

#if defined(ENABLE_OVERLOADING)
data MediaStreamSeekingPropertyInfo
instance AttrInfo MediaStreamSeekingPropertyInfo where
    type AttrAllowedOps MediaStreamSeekingPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint MediaStreamSeekingPropertyInfo = IsMediaStream
    type AttrSetTypeConstraint MediaStreamSeekingPropertyInfo = (~) ()
    type AttrTransferTypeConstraint MediaStreamSeekingPropertyInfo = (~) ()
    type AttrTransferType MediaStreamSeekingPropertyInfo = ()
    type AttrGetType MediaStreamSeekingPropertyInfo = Bool
    type AttrLabel MediaStreamSeekingPropertyInfo = "seeking"
    type AttrOrigin MediaStreamSeekingPropertyInfo = MediaStream
    attrGet = getMediaStreamSeeking
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

-- VVV Prop "timestamp"
   -- Type: TBasicType TInt64
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@timestamp@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' mediaStream #timestamp
-- @
getMediaStreamTimestamp :: (MonadIO m, IsMediaStream o) => o -> m Int64
getMediaStreamTimestamp :: o -> m Int64
getMediaStreamTimestamp obj :: o
obj = IO Int64 -> m Int64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int64 -> m Int64) -> IO Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Int64
forall a. GObject a => a -> String -> IO Int64
B.Properties.getObjectPropertyInt64 o
obj "timestamp"

#if defined(ENABLE_OVERLOADING)
data MediaStreamTimestampPropertyInfo
instance AttrInfo MediaStreamTimestampPropertyInfo where
    type AttrAllowedOps MediaStreamTimestampPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint MediaStreamTimestampPropertyInfo = IsMediaStream
    type AttrSetTypeConstraint MediaStreamTimestampPropertyInfo = (~) ()
    type AttrTransferTypeConstraint MediaStreamTimestampPropertyInfo = (~) ()
    type AttrTransferType MediaStreamTimestampPropertyInfo = ()
    type AttrGetType MediaStreamTimestampPropertyInfo = Int64
    type AttrLabel MediaStreamTimestampPropertyInfo = "timestamp"
    type AttrOrigin MediaStreamTimestampPropertyInfo = MediaStream
    attrGet = getMediaStreamTimestamp
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

-- VVV Prop "volume"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@volume@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' mediaStream #volume
-- @
getMediaStreamVolume :: (MonadIO m, IsMediaStream o) => o -> m Bool
getMediaStreamVolume :: o -> m Bool
getMediaStreamVolume obj :: o
obj = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj "volume"

-- | Set the value of the “@volume@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' mediaStream [ #volume 'Data.GI.Base.Attributes.:=' value ]
-- @
setMediaStreamVolume :: (MonadIO m, IsMediaStream o) => o -> Bool -> m ()
setMediaStreamVolume :: o -> Bool -> m ()
setMediaStreamVolume obj :: o
obj val :: Bool
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj "volume" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@volume@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructMediaStreamVolume :: (IsMediaStream o) => Bool -> IO (GValueConstruct o)
constructMediaStreamVolume :: Bool -> IO (GValueConstruct o)
constructMediaStreamVolume val :: Bool
val = String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool "volume" Bool
val

#if defined(ENABLE_OVERLOADING)
data MediaStreamVolumePropertyInfo
instance AttrInfo MediaStreamVolumePropertyInfo where
    type AttrAllowedOps MediaStreamVolumePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint MediaStreamVolumePropertyInfo = IsMediaStream
    type AttrSetTypeConstraint MediaStreamVolumePropertyInfo = (~) Bool
    type AttrTransferTypeConstraint MediaStreamVolumePropertyInfo = (~) Bool
    type AttrTransferType MediaStreamVolumePropertyInfo = Bool
    type AttrGetType MediaStreamVolumePropertyInfo = Bool
    type AttrLabel MediaStreamVolumePropertyInfo = "volume"
    type AttrOrigin MediaStreamVolumePropertyInfo = MediaStream
    attrGet = getMediaStreamVolume
    attrSet = setMediaStreamVolume
    attrTransfer _ v = do
        return v
    attrConstruct = constructMediaStreamVolume
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList MediaStream
type instance O.AttributeList MediaStream = MediaStreamAttributeList
type MediaStreamAttributeList = ('[ '("duration", MediaStreamDurationPropertyInfo), '("ended", MediaStreamEndedPropertyInfo), '("error", MediaStreamErrorPropertyInfo), '("hasAudio", MediaStreamHasAudioPropertyInfo), '("hasVideo", MediaStreamHasVideoPropertyInfo), '("loop", MediaStreamLoopPropertyInfo), '("muted", MediaStreamMutedPropertyInfo), '("playing", MediaStreamPlayingPropertyInfo), '("prepared", MediaStreamPreparedPropertyInfo), '("seekable", MediaStreamSeekablePropertyInfo), '("seeking", MediaStreamSeekingPropertyInfo), '("timestamp", MediaStreamTimestampPropertyInfo), '("volume", MediaStreamVolumePropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
mediaStreamDuration :: AttrLabelProxy "duration"
mediaStreamDuration = AttrLabelProxy

mediaStreamError :: AttrLabelProxy "error"
mediaStreamError = AttrLabelProxy

mediaStreamLoop :: AttrLabelProxy "loop"
mediaStreamLoop = AttrLabelProxy

mediaStreamMuted :: AttrLabelProxy "muted"
mediaStreamMuted = AttrLabelProxy

mediaStreamPlaying :: AttrLabelProxy "playing"
mediaStreamPlaying = AttrLabelProxy

mediaStreamSeekable :: AttrLabelProxy "seekable"
mediaStreamSeekable = AttrLabelProxy

mediaStreamSeeking :: AttrLabelProxy "seeking"
mediaStreamSeeking = AttrLabelProxy

mediaStreamTimestamp :: AttrLabelProxy "timestamp"
mediaStreamTimestamp = AttrLabelProxy

mediaStreamVolume :: AttrLabelProxy "volume"
mediaStreamVolume = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList MediaStream = MediaStreamSignalList
type MediaStreamSignalList = ('[ '("invalidateContents", Gdk.Paintable.PaintableInvalidateContentsSignalInfo), '("invalidateSize", Gdk.Paintable.PaintableInvalidateSizeSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

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

foreign import ccall "gtk_media_stream_ended" gtk_media_stream_ended :: 
    Ptr MediaStream ->                      -- self : TInterface (Name {namespace = "Gtk", name = "MediaStream"})
    IO ()

-- | Pauses the media stream and marks it as ended. This is a hint only, calls
-- to GtkMediaStream.@/play()/@ may still happen.
mediaStreamEnded ::
    (B.CallStack.HasCallStack, MonadIO m, IsMediaStream a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.MediaStream.MediaStream'
    -> m ()
mediaStreamEnded :: a -> m ()
mediaStreamEnded self :: a
self = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr MediaStream
self' <- a -> IO (Ptr MediaStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr MediaStream -> IO ()
gtk_media_stream_ended Ptr MediaStream
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MediaStreamEndedMethodInfo
instance (signature ~ (m ()), MonadIO m, IsMediaStream a) => O.MethodInfo MediaStreamEndedMethodInfo a signature where
    overloadedMethod = mediaStreamEnded

#endif

-- method MediaStream::gerror
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "MediaStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkMediaStream" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "error"
--           , argType = TError
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GError to set" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_media_stream_gerror" gtk_media_stream_gerror :: 
    Ptr MediaStream ->                      -- self : TInterface (Name {namespace = "Gtk", name = "MediaStream"})
    Ptr GError ->                           -- error : TError
    IO ()

-- | Sets /@self@/ into an error state. This will pause the stream
-- (you can check for an error via 'GI.Gtk.Objects.MediaStream.mediaStreamGetError' in
-- your GtkMediaStream.@/pause()/@ implementation), abort pending seeks
-- and mark the stream as prepared.
-- 
-- if the stream is already in an error state, this call will be ignored
-- and the existing error will be retained.
-- FIXME: Or do we want to set the new error?
-- 
-- To unset an error, the stream must be reset via a call to
-- 'GI.Gtk.Objects.MediaStream.mediaStreamUnprepared'.
mediaStreamGerror ::
    (B.CallStack.HasCallStack, MonadIO m, IsMediaStream a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.MediaStream.MediaStream'
    -> GError
    -- ^ /@error@/: the t'GError' to set
    -> m ()
mediaStreamGerror :: a -> GError -> m ()
mediaStreamGerror self :: a
self error_ :: GError
error_ = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr MediaStream
self' <- a -> IO (Ptr MediaStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr GError
error_' <- GError -> IO (Ptr GError)
forall a. (HasCallStack, BoxedObject a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed GError
error_
    Ptr MediaStream -> Ptr GError -> IO ()
gtk_media_stream_gerror Ptr MediaStream
self' Ptr GError
error_'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    GError -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GError
error_
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MediaStreamGerrorMethodInfo
instance (signature ~ (GError -> m ()), MonadIO m, IsMediaStream a) => O.MethodInfo MediaStreamGerrorMethodInfo a signature where
    overloadedMethod = mediaStreamGerror

#endif

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

foreign import ccall "gtk_media_stream_get_duration" gtk_media_stream_get_duration :: 
    Ptr MediaStream ->                      -- self : TInterface (Name {namespace = "Gtk", name = "MediaStream"})
    IO Int64

-- | Gets the duration of the stream. If the duration is not known,
-- 0 will be returned.
mediaStreamGetDuration ::
    (B.CallStack.HasCallStack, MonadIO m, IsMediaStream a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.MediaStream.MediaStream'
    -> m Int64
    -- ^ __Returns:__ the duration of the stream or 0 if not known.
mediaStreamGetDuration :: a -> m Int64
mediaStreamGetDuration self :: a
self = IO Int64 -> m Int64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int64 -> m Int64) -> IO Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ do
    Ptr MediaStream
self' <- a -> IO (Ptr MediaStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Int64
result <- Ptr MediaStream -> IO Int64
gtk_media_stream_get_duration Ptr MediaStream
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Int64 -> IO Int64
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
result

#if defined(ENABLE_OVERLOADING)
data MediaStreamGetDurationMethodInfo
instance (signature ~ (m Int64), MonadIO m, IsMediaStream a) => O.MethodInfo MediaStreamGetDurationMethodInfo a signature where
    overloadedMethod = mediaStreamGetDuration

#endif

-- method MediaStream::get_ended
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "MediaStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkMediaStream" , 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 "gtk_media_stream_get_ended" gtk_media_stream_get_ended :: 
    Ptr MediaStream ->                      -- self : TInterface (Name {namespace = "Gtk", name = "MediaStream"})
    IO CInt

-- | Returns whether the streams playback is finished.
mediaStreamGetEnded ::
    (B.CallStack.HasCallStack, MonadIO m, IsMediaStream a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.MediaStream.MediaStream'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if playback is finished
mediaStreamGetEnded :: a -> m Bool
mediaStreamGetEnded self :: a
self = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr MediaStream
self' <- a -> IO (Ptr MediaStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr MediaStream -> IO CInt
gtk_media_stream_get_ended Ptr MediaStream
self'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MediaStreamGetEndedMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsMediaStream a) => O.MethodInfo MediaStreamGetEndedMethodInfo a signature where
    overloadedMethod = mediaStreamGetEnded

#endif

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

foreign import ccall "gtk_media_stream_get_error" gtk_media_stream_get_error :: 
    Ptr MediaStream ->                      -- self : TInterface (Name {namespace = "Gtk", name = "MediaStream"})
    IO (Ptr GError)

-- | If the stream is in an error state, returns the t'GError' explaining that state.
-- Any type of error can be reported here depending on the implementation of the
-- media stream.
-- 
-- A media stream in an error cannot be operated on, calls like
-- 'GI.Gtk.Objects.MediaStream.mediaStreamPlay' or 'GI.Gtk.Objects.MediaStream.mediaStreamSeek' will not have any effect.
-- 
-- t'GI.Gtk.Objects.MediaStream.MediaStream' itself does not provide a way to unset an error, but
-- implementations may provide options. For example, a t'GI.Gtk.Objects.MediaFile.MediaFile' will unset
-- errors when a new source is set with ie 'GI.Gtk.Objects.MediaFile.mediaFileSetFile'.
mediaStreamGetError ::
    (B.CallStack.HasCallStack, MonadIO m, IsMediaStream a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.MediaStream.MediaStream'
    -> m (Maybe GError)
    -- ^ __Returns:__ 'P.Nothing' if not in an error state or
    --    the t'GError' of the stream
mediaStreamGetError :: a -> m (Maybe GError)
mediaStreamGetError self :: a
self = IO (Maybe GError) -> m (Maybe GError)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe GError) -> m (Maybe GError))
-> IO (Maybe GError) -> m (Maybe GError)
forall a b. (a -> b) -> a -> b
$ do
    Ptr MediaStream
self' <- a -> IO (Ptr MediaStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr GError
result <- Ptr MediaStream -> IO (Ptr GError)
gtk_media_stream_get_error Ptr MediaStream
self'
    Maybe GError
maybeResult <- Ptr GError -> (Ptr GError -> IO GError) -> IO (Maybe GError)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr GError
result ((Ptr GError -> IO GError) -> IO (Maybe GError))
-> (Ptr GError -> IO GError) -> IO (Maybe GError)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr GError
result' -> do
        GError
result'' <- ((ManagedPtr GError -> GError) -> Ptr GError -> IO GError
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr GError -> GError
GError) Ptr GError
result'
        GError -> IO GError
forall (m :: * -> *) a. Monad m => a -> m a
return GError
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe GError -> IO (Maybe GError)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GError
maybeResult

#if defined(ENABLE_OVERLOADING)
data MediaStreamGetErrorMethodInfo
instance (signature ~ (m (Maybe GError)), MonadIO m, IsMediaStream a) => O.MethodInfo MediaStreamGetErrorMethodInfo a signature where
    overloadedMethod = mediaStreamGetError

#endif

-- method MediaStream::get_loop
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "MediaStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkMediaStream" , 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 "gtk_media_stream_get_loop" gtk_media_stream_get_loop :: 
    Ptr MediaStream ->                      -- self : TInterface (Name {namespace = "Gtk", name = "MediaStream"})
    IO CInt

-- | Returns whether the stream is set to loop. See
-- 'GI.Gtk.Objects.MediaStream.mediaStreamSetLoop' for details.
mediaStreamGetLoop ::
    (B.CallStack.HasCallStack, MonadIO m, IsMediaStream a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.MediaStream.MediaStream'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the stream should loop
mediaStreamGetLoop :: a -> m Bool
mediaStreamGetLoop self :: a
self = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr MediaStream
self' <- a -> IO (Ptr MediaStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr MediaStream -> IO CInt
gtk_media_stream_get_loop Ptr MediaStream
self'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MediaStreamGetLoopMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsMediaStream a) => O.MethodInfo MediaStreamGetLoopMethodInfo a signature where
    overloadedMethod = mediaStreamGetLoop

#endif

-- method MediaStream::get_muted
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "MediaStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkMediaStream" , 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 "gtk_media_stream_get_muted" gtk_media_stream_get_muted :: 
    Ptr MediaStream ->                      -- self : TInterface (Name {namespace = "Gtk", name = "MediaStream"})
    IO CInt

-- | Returns whether the audio for the stream is muted.
-- See 'GI.Gtk.Objects.MediaStream.mediaStreamSetMuted' for details.
mediaStreamGetMuted ::
    (B.CallStack.HasCallStack, MonadIO m, IsMediaStream a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.MediaStream.MediaStream'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the stream is muted
mediaStreamGetMuted :: a -> m Bool
mediaStreamGetMuted self :: a
self = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr MediaStream
self' <- a -> IO (Ptr MediaStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr MediaStream -> IO CInt
gtk_media_stream_get_muted Ptr MediaStream
self'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MediaStreamGetMutedMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsMediaStream a) => O.MethodInfo MediaStreamGetMutedMethodInfo a signature where
    overloadedMethod = mediaStreamGetMuted

#endif

-- method MediaStream::get_playing
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "MediaStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkMediaStream" , 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 "gtk_media_stream_get_playing" gtk_media_stream_get_playing :: 
    Ptr MediaStream ->                      -- self : TInterface (Name {namespace = "Gtk", name = "MediaStream"})
    IO CInt

-- | Return whether the stream is currently playing.
mediaStreamGetPlaying ::
    (B.CallStack.HasCallStack, MonadIO m, IsMediaStream a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.MediaStream.MediaStream'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the stream is playing
mediaStreamGetPlaying :: a -> m Bool
mediaStreamGetPlaying self :: a
self = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr MediaStream
self' <- a -> IO (Ptr MediaStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr MediaStream -> IO CInt
gtk_media_stream_get_playing Ptr MediaStream
self'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MediaStreamGetPlayingMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsMediaStream a) => O.MethodInfo MediaStreamGetPlayingMethodInfo a signature where
    overloadedMethod = mediaStreamGetPlaying

#endif

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

foreign import ccall "gtk_media_stream_get_timestamp" gtk_media_stream_get_timestamp :: 
    Ptr MediaStream ->                      -- self : TInterface (Name {namespace = "Gtk", name = "MediaStream"})
    IO Int64

-- | Returns the current presentation timestamp in microseconds.
mediaStreamGetTimestamp ::
    (B.CallStack.HasCallStack, MonadIO m, IsMediaStream a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.MediaStream.MediaStream'
    -> m Int64
    -- ^ __Returns:__ the timestamp in microseconds
mediaStreamGetTimestamp :: a -> m Int64
mediaStreamGetTimestamp self :: a
self = IO Int64 -> m Int64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int64 -> m Int64) -> IO Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ do
    Ptr MediaStream
self' <- a -> IO (Ptr MediaStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Int64
result <- Ptr MediaStream -> IO Int64
gtk_media_stream_get_timestamp Ptr MediaStream
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Int64 -> IO Int64
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
result

#if defined(ENABLE_OVERLOADING)
data MediaStreamGetTimestampMethodInfo
instance (signature ~ (m Int64), MonadIO m, IsMediaStream a) => O.MethodInfo MediaStreamGetTimestampMethodInfo a signature where
    overloadedMethod = mediaStreamGetTimestamp

#endif

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

foreign import ccall "gtk_media_stream_get_volume" gtk_media_stream_get_volume :: 
    Ptr MediaStream ->                      -- self : TInterface (Name {namespace = "Gtk", name = "MediaStream"})
    IO CDouble

-- | Returns the volume of the audio for the stream.
-- See 'GI.Gtk.Objects.MediaStream.mediaStreamSetVolume' for details.
mediaStreamGetVolume ::
    (B.CallStack.HasCallStack, MonadIO m, IsMediaStream a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.MediaStream.MediaStream'
    -> m Double
    -- ^ __Returns:__ volume of the stream from 0.0 to 1.0
mediaStreamGetVolume :: a -> m Double
mediaStreamGetVolume self :: a
self = IO Double -> m Double
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ do
    Ptr MediaStream
self' <- a -> IO (Ptr MediaStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CDouble
result <- Ptr MediaStream -> IO CDouble
gtk_media_stream_get_volume Ptr MediaStream
self'
    let result' :: Double
result' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
data MediaStreamGetVolumeMethodInfo
instance (signature ~ (m Double), MonadIO m, IsMediaStream a) => O.MethodInfo MediaStreamGetVolumeMethodInfo a signature where
    overloadedMethod = mediaStreamGetVolume

#endif

-- method MediaStream::has_audio
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "MediaStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkMediaStream" , 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 "gtk_media_stream_has_audio" gtk_media_stream_has_audio :: 
    Ptr MediaStream ->                      -- self : TInterface (Name {namespace = "Gtk", name = "MediaStream"})
    IO CInt

-- | Returns whether the stream has audio.
mediaStreamHasAudio ::
    (B.CallStack.HasCallStack, MonadIO m, IsMediaStream a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.MediaStream.MediaStream'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the stream has audio
mediaStreamHasAudio :: a -> m Bool
mediaStreamHasAudio self :: a
self = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr MediaStream
self' <- a -> IO (Ptr MediaStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr MediaStream -> IO CInt
gtk_media_stream_has_audio Ptr MediaStream
self'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MediaStreamHasAudioMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsMediaStream a) => O.MethodInfo MediaStreamHasAudioMethodInfo a signature where
    overloadedMethod = mediaStreamHasAudio

#endif

-- method MediaStream::has_video
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "MediaStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkMediaStream" , 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 "gtk_media_stream_has_video" gtk_media_stream_has_video :: 
    Ptr MediaStream ->                      -- self : TInterface (Name {namespace = "Gtk", name = "MediaStream"})
    IO CInt

-- | Returns whether the stream has video.
mediaStreamHasVideo ::
    (B.CallStack.HasCallStack, MonadIO m, IsMediaStream a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.MediaStream.MediaStream'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the stream has video
mediaStreamHasVideo :: a -> m Bool
mediaStreamHasVideo self :: a
self = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr MediaStream
self' <- a -> IO (Ptr MediaStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr MediaStream -> IO CInt
gtk_media_stream_has_video Ptr MediaStream
self'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MediaStreamHasVideoMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsMediaStream a) => O.MethodInfo MediaStreamHasVideoMethodInfo a signature where
    overloadedMethod = mediaStreamHasVideo

#endif

-- method MediaStream::is_prepared
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "MediaStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkMediaStream" , 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 "gtk_media_stream_is_prepared" gtk_media_stream_is_prepared :: 
    Ptr MediaStream ->                      -- self : TInterface (Name {namespace = "Gtk", name = "MediaStream"})
    IO CInt

-- | Returns whether the stream has finished initializing and existence of
-- audio and video is known.
mediaStreamIsPrepared ::
    (B.CallStack.HasCallStack, MonadIO m, IsMediaStream a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.MediaStream.MediaStream'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the stream is prepared
mediaStreamIsPrepared :: a -> m Bool
mediaStreamIsPrepared self :: a
self = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr MediaStream
self' <- a -> IO (Ptr MediaStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr MediaStream -> IO CInt
gtk_media_stream_is_prepared Ptr MediaStream
self'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MediaStreamIsPreparedMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsMediaStream a) => O.MethodInfo MediaStreamIsPreparedMethodInfo a signature where
    overloadedMethod = mediaStreamIsPrepared

#endif

-- method MediaStream::is_seekable
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "MediaStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkMediaStream" , 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 "gtk_media_stream_is_seekable" gtk_media_stream_is_seekable :: 
    Ptr MediaStream ->                      -- self : TInterface (Name {namespace = "Gtk", name = "MediaStream"})
    IO CInt

-- | Checks if a stream may be seekable.
-- 
-- This is meant to be a hint. Streams may not allow seeking even if
-- this function returns 'P.True'. However, if this function returns
-- 'P.False', streams are guaranteed to not be seekable and user interfaces
-- may hide controls that allow seeking.
-- 
-- It is allowed to call 'GI.Gtk.Objects.MediaStream.mediaStreamSeek' on a non-seekable
-- stream, though it will not do anything.
mediaStreamIsSeekable ::
    (B.CallStack.HasCallStack, MonadIO m, IsMediaStream a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.MediaStream.MediaStream'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the stream may support seeking
mediaStreamIsSeekable :: a -> m Bool
mediaStreamIsSeekable self :: a
self = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr MediaStream
self' <- a -> IO (Ptr MediaStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr MediaStream -> IO CInt
gtk_media_stream_is_seekable Ptr MediaStream
self'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MediaStreamIsSeekableMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsMediaStream a) => O.MethodInfo MediaStreamIsSeekableMethodInfo a signature where
    overloadedMethod = mediaStreamIsSeekable

#endif

-- method MediaStream::is_seeking
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "MediaStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkMediaStream" , 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 "gtk_media_stream_is_seeking" gtk_media_stream_is_seeking :: 
    Ptr MediaStream ->                      -- self : TInterface (Name {namespace = "Gtk", name = "MediaStream"})
    IO CInt

-- | Checks if there is currently a seek operation going on.
mediaStreamIsSeeking ::
    (B.CallStack.HasCallStack, MonadIO m, IsMediaStream a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.MediaStream.MediaStream'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if a seek operation is ongoing.
mediaStreamIsSeeking :: a -> m Bool
mediaStreamIsSeeking self :: a
self = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr MediaStream
self' <- a -> IO (Ptr MediaStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr MediaStream -> IO CInt
gtk_media_stream_is_seeking Ptr MediaStream
self'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MediaStreamIsSeekingMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsMediaStream a) => O.MethodInfo MediaStreamIsSeekingMethodInfo a signature where
    overloadedMethod = mediaStreamIsSeeking

#endif

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

foreign import ccall "gtk_media_stream_pause" gtk_media_stream_pause :: 
    Ptr MediaStream ->                      -- self : TInterface (Name {namespace = "Gtk", name = "MediaStream"})
    IO ()

-- | Pauses playback of the stream. If the stream
-- is not playing, do nothing.
mediaStreamPause ::
    (B.CallStack.HasCallStack, MonadIO m, IsMediaStream a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.MediaStream.MediaStream'
    -> m ()
mediaStreamPause :: a -> m ()
mediaStreamPause self :: a
self = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr MediaStream
self' <- a -> IO (Ptr MediaStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr MediaStream -> IO ()
gtk_media_stream_pause Ptr MediaStream
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MediaStreamPauseMethodInfo
instance (signature ~ (m ()), MonadIO m, IsMediaStream a) => O.MethodInfo MediaStreamPauseMethodInfo a signature where
    overloadedMethod = mediaStreamPause

#endif

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

foreign import ccall "gtk_media_stream_play" gtk_media_stream_play :: 
    Ptr MediaStream ->                      -- self : TInterface (Name {namespace = "Gtk", name = "MediaStream"})
    IO ()

-- | Starts playing the stream. If the stream
-- is in error or already playing, do nothing.
mediaStreamPlay ::
    (B.CallStack.HasCallStack, MonadIO m, IsMediaStream a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.MediaStream.MediaStream'
    -> m ()
mediaStreamPlay :: a -> m ()
mediaStreamPlay self :: a
self = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr MediaStream
self' <- a -> IO (Ptr MediaStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr MediaStream -> IO ()
gtk_media_stream_play Ptr MediaStream
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MediaStreamPlayMethodInfo
instance (signature ~ (m ()), MonadIO m, IsMediaStream a) => O.MethodInfo MediaStreamPlayMethodInfo a signature where
    overloadedMethod = mediaStreamPlay

#endif

-- method MediaStream::prepared
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "MediaStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkMediaStream" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "has_audio"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "%TRUE if the stream should advertise audio support"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "has_video"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "%TRUE if the stream should advertise video support"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "seekable"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "%TRUE if the stream should advertise seekability"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "duration"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The duration of the stream or 0 if unknown"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_media_stream_prepared" gtk_media_stream_prepared :: 
    Ptr MediaStream ->                      -- self : TInterface (Name {namespace = "Gtk", name = "MediaStream"})
    CInt ->                                 -- has_audio : TBasicType TBoolean
    CInt ->                                 -- has_video : TBasicType TBoolean
    CInt ->                                 -- seekable : TBasicType TBoolean
    Int64 ->                                -- duration : TBasicType TInt64
    IO ()

-- | Called by t'GI.Gtk.Objects.MediaStream.MediaStream' implementations to advertise the stream
-- being ready to play and providing details about the stream.
-- 
-- Note that the arguments are hints. If the stream implementation
-- cannot determine the correct values, it is better to err on the
-- side of caution and return 'P.True'. User interfaces will use those
-- values to determine what controls to show.
-- 
-- This function may not be called again until the stream has been
-- reset via 'GI.Gtk.Objects.MediaStream.mediaStreamUnprepared'.
mediaStreamPrepared ::
    (B.CallStack.HasCallStack, MonadIO m, IsMediaStream a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.MediaStream.MediaStream'
    -> Bool
    -- ^ /@hasAudio@/: 'P.True' if the stream should advertise audio support
    -> Bool
    -- ^ /@hasVideo@/: 'P.True' if the stream should advertise video support
    -> Bool
    -- ^ /@seekable@/: 'P.True' if the stream should advertise seekability
    -> Int64
    -- ^ /@duration@/: The duration of the stream or 0 if unknown
    -> m ()
mediaStreamPrepared :: a -> Bool -> Bool -> Bool -> Int64 -> m ()
mediaStreamPrepared self :: a
self hasAudio :: Bool
hasAudio hasVideo :: Bool
hasVideo seekable :: Bool
seekable duration :: Int64
duration = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr MediaStream
self' <- a -> IO (Ptr MediaStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let hasAudio' :: CInt
hasAudio' = (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
hasAudio
    let hasVideo' :: CInt
hasVideo' = (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
hasVideo
    let seekable' :: CInt
seekable' = (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
seekable
    Ptr MediaStream -> CInt -> CInt -> CInt -> Int64 -> IO ()
gtk_media_stream_prepared Ptr MediaStream
self' CInt
hasAudio' CInt
hasVideo' CInt
seekable' Int64
duration
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MediaStreamPreparedMethodInfo
instance (signature ~ (Bool -> Bool -> Bool -> Int64 -> m ()), MonadIO m, IsMediaStream a) => O.MethodInfo MediaStreamPreparedMethodInfo a signature where
    overloadedMethod = mediaStreamPrepared

#endif

-- method MediaStream::realize
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "MediaStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkMediaStream" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "surface"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Surface" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkSurface" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_media_stream_realize" gtk_media_stream_realize :: 
    Ptr MediaStream ->                      -- self : TInterface (Name {namespace = "Gtk", name = "MediaStream"})
    Ptr Gdk.Surface.Surface ->              -- surface : TInterface (Name {namespace = "Gdk", name = "Surface"})
    IO ()

-- | Called by users to attach the media stream to a t'GI.Gdk.Objects.Surface.Surface' they manage.
-- The stream can then access the resources of /@surface@/ for its rendering
-- purposes. In particular, media streams might want to create
-- @/GdkGLContexts/@ or sync to the t'GI.Gdk.Objects.FrameClock.FrameClock'.
-- 
-- Whoever calls this function is responsible for calling
-- 'GI.Gtk.Objects.MediaStream.mediaStreamUnrealize' before either the stream or /@surface@/ get
-- destroyed.
-- 
-- Multiple calls to this function may happen from different users of the
-- video, even with the same /@surface@/. Each of these calls must be followed
-- by its own call to 'GI.Gtk.Objects.MediaStream.mediaStreamUnrealize'.
-- 
-- It is not required to call this function to make a media stream work.
mediaStreamRealize ::
    (B.CallStack.HasCallStack, MonadIO m, IsMediaStream a, Gdk.Surface.IsSurface b) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.MediaStream.MediaStream'
    -> b
    -- ^ /@surface@/: a t'GI.Gdk.Objects.Surface.Surface'
    -> m ()
mediaStreamRealize :: a -> b -> m ()
mediaStreamRealize self :: a
self surface :: b
surface = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr MediaStream
self' <- a -> IO (Ptr MediaStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Surface
surface' <- b -> IO (Ptr Surface)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
surface
    Ptr MediaStream -> Ptr Surface -> IO ()
gtk_media_stream_realize Ptr MediaStream
self' Ptr Surface
surface'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
surface
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MediaStreamRealizeMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsMediaStream a, Gdk.Surface.IsSurface b) => O.MethodInfo MediaStreamRealizeMethodInfo a signature where
    overloadedMethod = mediaStreamRealize

#endif

-- method MediaStream::seek
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "MediaStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkMediaStream" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timestamp"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "timestamp to seek to."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_media_stream_seek" gtk_media_stream_seek :: 
    Ptr MediaStream ->                      -- self : TInterface (Name {namespace = "Gtk", name = "MediaStream"})
    Int64 ->                                -- timestamp : TBasicType TInt64
    IO ()

-- | Start a seek operation on /@self@/ to /@timestamp@/. If /@timestamp@/ is out of range,
-- it will be clamped.
-- 
-- Seek operations may not finish instantly. While a seek operation is
-- in process, the GtkMediaStream:seeking property will be set.
-- 
-- When calling 'GI.Gtk.Objects.MediaStream.mediaStreamSeek' during an ongoing seek operation,
-- the new seek wil override any pending seek.
mediaStreamSeek ::
    (B.CallStack.HasCallStack, MonadIO m, IsMediaStream a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.MediaStream.MediaStream'
    -> Int64
    -- ^ /@timestamp@/: timestamp to seek to.
    -> m ()
mediaStreamSeek :: a -> Int64 -> m ()
mediaStreamSeek self :: a
self timestamp :: Int64
timestamp = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr MediaStream
self' <- a -> IO (Ptr MediaStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr MediaStream -> Int64 -> IO ()
gtk_media_stream_seek Ptr MediaStream
self' Int64
timestamp
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MediaStreamSeekMethodInfo
instance (signature ~ (Int64 -> m ()), MonadIO m, IsMediaStream a) => O.MethodInfo MediaStreamSeekMethodInfo a signature where
    overloadedMethod = mediaStreamSeek

#endif

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

foreign import ccall "gtk_media_stream_seek_failed" gtk_media_stream_seek_failed :: 
    Ptr MediaStream ->                      -- self : TInterface (Name {namespace = "Gtk", name = "MediaStream"})
    IO ()

-- | Ends a seek operation started via GtkMediaStream.@/seek()/@ as a failure.
-- This will not cause an error on the stream and will assume that
-- playback continues as if no seek had happened.
-- 
-- See 'GI.Gtk.Objects.MediaStream.mediaStreamSeekSuccess' for the other way of
-- ending a seek.
mediaStreamSeekFailed ::
    (B.CallStack.HasCallStack, MonadIO m, IsMediaStream a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.MediaStream.MediaStream'
    -> m ()
mediaStreamSeekFailed :: a -> m ()
mediaStreamSeekFailed self :: a
self = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr MediaStream
self' <- a -> IO (Ptr MediaStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr MediaStream -> IO ()
gtk_media_stream_seek_failed Ptr MediaStream
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MediaStreamSeekFailedMethodInfo
instance (signature ~ (m ()), MonadIO m, IsMediaStream a) => O.MethodInfo MediaStreamSeekFailedMethodInfo a signature where
    overloadedMethod = mediaStreamSeekFailed

#endif

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

foreign import ccall "gtk_media_stream_seek_success" gtk_media_stream_seek_success :: 
    Ptr MediaStream ->                      -- self : TInterface (Name {namespace = "Gtk", name = "MediaStream"})
    IO ()

-- | Ends a seek operation started via GtkMediaStream.@/seek()/@ successfully.
-- This function will unset the GtkMediaStream:ended property if it was
-- set.
-- 
-- See 'GI.Gtk.Objects.MediaStream.mediaStreamSeekFailed' for the other way of
-- ending a seek.
mediaStreamSeekSuccess ::
    (B.CallStack.HasCallStack, MonadIO m, IsMediaStream a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.MediaStream.MediaStream'
    -> m ()
mediaStreamSeekSuccess :: a -> m ()
mediaStreamSeekSuccess self :: a
self = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr MediaStream
self' <- a -> IO (Ptr MediaStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr MediaStream -> IO ()
gtk_media_stream_seek_success Ptr MediaStream
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MediaStreamSeekSuccessMethodInfo
instance (signature ~ (m ()), MonadIO m, IsMediaStream a) => O.MethodInfo MediaStreamSeekSuccessMethodInfo a signature where
    overloadedMethod = mediaStreamSeekSuccess

#endif

-- method MediaStream::set_loop
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "MediaStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkMediaStream" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "loop"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "%TRUE if the stream should loop"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_media_stream_set_loop" gtk_media_stream_set_loop :: 
    Ptr MediaStream ->                      -- self : TInterface (Name {namespace = "Gtk", name = "MediaStream"})
    CInt ->                                 -- loop : TBasicType TBoolean
    IO ()

-- | Sets whether the stream should loop, ie restart playback from
-- the beginning instead of stopping at the end.
-- 
-- Not all streams may support looping, in particular non-seekable
-- streams. Those streams will ignore the loop setting and just end.
mediaStreamSetLoop ::
    (B.CallStack.HasCallStack, MonadIO m, IsMediaStream a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.MediaStream.MediaStream'
    -> Bool
    -- ^ /@loop@/: 'P.True' if the stream should loop
    -> m ()
mediaStreamSetLoop :: a -> Bool -> m ()
mediaStreamSetLoop self :: a
self loop :: Bool
loop = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr MediaStream
self' <- a -> IO (Ptr MediaStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let loop' :: CInt
loop' = (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
loop
    Ptr MediaStream -> CInt -> IO ()
gtk_media_stream_set_loop Ptr MediaStream
self' CInt
loop'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MediaStreamSetLoopMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsMediaStream a) => O.MethodInfo MediaStreamSetLoopMethodInfo a signature where
    overloadedMethod = mediaStreamSetLoop

#endif

-- method MediaStream::set_muted
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "MediaStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkMediaStream" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "muted"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "%TRUE if the stream should be muted"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_media_stream_set_muted" gtk_media_stream_set_muted :: 
    Ptr MediaStream ->                      -- self : TInterface (Name {namespace = "Gtk", name = "MediaStream"})
    CInt ->                                 -- muted : TBasicType TBoolean
    IO ()

-- | Sets whether the audio stream should be muted. Muting a stream will
-- cause no audio to be played, but it does not modify the volume.
-- This means that muting and then unmuting the stream will restore
-- the volume settings.
-- 
-- If the stream has no audio, calling this function will still work
-- but it will not have an audible effect.
mediaStreamSetMuted ::
    (B.CallStack.HasCallStack, MonadIO m, IsMediaStream a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.MediaStream.MediaStream'
    -> Bool
    -- ^ /@muted@/: 'P.True' if the stream should be muted
    -> m ()
mediaStreamSetMuted :: a -> Bool -> m ()
mediaStreamSetMuted self :: a
self muted :: Bool
muted = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr MediaStream
self' <- a -> IO (Ptr MediaStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let muted' :: CInt
muted' = (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
muted
    Ptr MediaStream -> CInt -> IO ()
gtk_media_stream_set_muted Ptr MediaStream
self' CInt
muted'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MediaStreamSetMutedMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsMediaStream a) => O.MethodInfo MediaStreamSetMutedMethodInfo a signature where
    overloadedMethod = mediaStreamSetMuted

#endif

-- method MediaStream::set_playing
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "MediaStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkMediaStream" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "playing"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "whether to start or pause playback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_media_stream_set_playing" gtk_media_stream_set_playing :: 
    Ptr MediaStream ->                      -- self : TInterface (Name {namespace = "Gtk", name = "MediaStream"})
    CInt ->                                 -- playing : TBasicType TBoolean
    IO ()

-- | Starts or pauses playback of the stream.
mediaStreamSetPlaying ::
    (B.CallStack.HasCallStack, MonadIO m, IsMediaStream a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.MediaStream.MediaStream'
    -> Bool
    -- ^ /@playing@/: whether to start or pause playback
    -> m ()
mediaStreamSetPlaying :: a -> Bool -> m ()
mediaStreamSetPlaying self :: a
self playing :: Bool
playing = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr MediaStream
self' <- a -> IO (Ptr MediaStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let playing' :: CInt
playing' = (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
playing
    Ptr MediaStream -> CInt -> IO ()
gtk_media_stream_set_playing Ptr MediaStream
self' CInt
playing'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MediaStreamSetPlayingMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsMediaStream a) => O.MethodInfo MediaStreamSetPlayingMethodInfo a signature where
    overloadedMethod = mediaStreamSetPlaying

#endif

-- method MediaStream::set_volume
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "MediaStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkMediaStream" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "volume"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "New volume of the stream from 0.0 to 1.0"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_media_stream_set_volume" gtk_media_stream_set_volume :: 
    Ptr MediaStream ->                      -- self : TInterface (Name {namespace = "Gtk", name = "MediaStream"})
    CDouble ->                              -- volume : TBasicType TDouble
    IO ()

-- | Sets the volume of the audio stream. This function call will work even if
-- the stream is muted.
-- 
-- The given /@volume@/ should range from 0.0 for silence to 1.0 for as loud as
-- possible. Values outside of this range will be clamped to the nearest
-- value.
-- 
-- If the stream has no audio or is muted, calling this function will still
-- work but it will not have an immediate audible effect. When the stream is
-- unmuted, the new volume setting will take effect.
mediaStreamSetVolume ::
    (B.CallStack.HasCallStack, MonadIO m, IsMediaStream a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.MediaStream.MediaStream'
    -> Double
    -- ^ /@volume@/: New volume of the stream from 0.0 to 1.0
    -> m ()
mediaStreamSetVolume :: a -> Double -> m ()
mediaStreamSetVolume self :: a
self volume :: Double
volume = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr MediaStream
self' <- a -> IO (Ptr MediaStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let volume' :: CDouble
volume' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
volume
    Ptr MediaStream -> CDouble -> IO ()
gtk_media_stream_set_volume Ptr MediaStream
self' CDouble
volume'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MediaStreamSetVolumeMethodInfo
instance (signature ~ (Double -> m ()), MonadIO m, IsMediaStream a) => O.MethodInfo MediaStreamSetVolumeMethodInfo a signature where
    overloadedMethod = mediaStreamSetVolume

#endif

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

foreign import ccall "gtk_media_stream_unprepared" gtk_media_stream_unprepared :: 
    Ptr MediaStream ->                      -- self : TInterface (Name {namespace = "Gtk", name = "MediaStream"})
    IO ()

-- | Resets a given media stream implementation. 'GI.Gtk.Objects.MediaStream.mediaStreamPrepared'
-- can now be called again.
-- 
-- This function will also reset any error state the stream was in.
mediaStreamUnprepared ::
    (B.CallStack.HasCallStack, MonadIO m, IsMediaStream a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.MediaStream.MediaStream'
    -> m ()
mediaStreamUnprepared :: a -> m ()
mediaStreamUnprepared self :: a
self = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr MediaStream
self' <- a -> IO (Ptr MediaStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr MediaStream -> IO ()
gtk_media_stream_unprepared Ptr MediaStream
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MediaStreamUnpreparedMethodInfo
instance (signature ~ (m ()), MonadIO m, IsMediaStream a) => O.MethodInfo MediaStreamUnpreparedMethodInfo a signature where
    overloadedMethod = mediaStreamUnprepared

#endif

-- method MediaStream::unrealize
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "MediaStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkMediaStream previously realized"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "surface"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Surface" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GdkSurface the stream was realized with"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_media_stream_unrealize" gtk_media_stream_unrealize :: 
    Ptr MediaStream ->                      -- self : TInterface (Name {namespace = "Gtk", name = "MediaStream"})
    Ptr Gdk.Surface.Surface ->              -- surface : TInterface (Name {namespace = "Gdk", name = "Surface"})
    IO ()

-- | Undoes a previous call to 'GI.Gtk.Objects.MediaStream.mediaStreamRealize' and causes
-- the stream to release all resources it had allocated from /@surface@/.
mediaStreamUnrealize ::
    (B.CallStack.HasCallStack, MonadIO m, IsMediaStream a, Gdk.Surface.IsSurface b) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.MediaStream.MediaStream' previously realized
    -> b
    -- ^ /@surface@/: the t'GI.Gdk.Objects.Surface.Surface' the stream was realized with
    -> m ()
mediaStreamUnrealize :: a -> b -> m ()
mediaStreamUnrealize self :: a
self surface :: b
surface = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr MediaStream
self' <- a -> IO (Ptr MediaStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Surface
surface' <- b -> IO (Ptr Surface)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
surface
    Ptr MediaStream -> Ptr Surface -> IO ()
gtk_media_stream_unrealize Ptr MediaStream
self' Ptr Surface
surface'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
surface
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MediaStreamUnrealizeMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsMediaStream a, Gdk.Surface.IsSurface b) => O.MethodInfo MediaStreamUnrealizeMethodInfo a signature where
    overloadedMethod = mediaStreamUnrealize

#endif

-- method MediaStream::update
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "MediaStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkMediaStream" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timestamp"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new timestamp" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_media_stream_update" gtk_media_stream_update :: 
    Ptr MediaStream ->                      -- self : TInterface (Name {namespace = "Gtk", name = "MediaStream"})
    Int64 ->                                -- timestamp : TBasicType TInt64
    IO ()

-- | Media stream implementations should regularly call this function to
-- update the timestamp reported by the stream. It is up to
-- implementations to call this at the frequency they deem appropriate.
mediaStreamUpdate ::
    (B.CallStack.HasCallStack, MonadIO m, IsMediaStream a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.MediaStream.MediaStream'
    -> Int64
    -- ^ /@timestamp@/: the new timestamp
    -> m ()
mediaStreamUpdate :: a -> Int64 -> m ()
mediaStreamUpdate self :: a
self timestamp :: Int64
timestamp = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr MediaStream
self' <- a -> IO (Ptr MediaStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr MediaStream -> Int64 -> IO ()
gtk_media_stream_update Ptr MediaStream
self' Int64
timestamp
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MediaStreamUpdateMethodInfo
instance (signature ~ (Int64 -> m ()), MonadIO m, IsMediaStream a) => O.MethodInfo MediaStreamUpdateMethodInfo a signature where
    overloadedMethod = mediaStreamUpdate

#endif