{-# 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.GstBase.Objects.DataQueue.DataQueue' is an object that handles threadsafe queueing of objects. It
-- also provides size-related functionality. This object should be used for
-- any t'GI.Gst.Objects.Element.Element' that wishes to provide some sort of queueing functionality.

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

module GI.GstBase.Objects.DataQueue
    ( 

-- * Exported types
    DataQueue(..)                           ,
    IsDataQueue                             ,
    toDataQueue                             ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveDataQueueMethod                  ,
#endif




 -- * Properties
-- ** currentLevelBytes #attr:currentLevelBytes#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    DataQueueCurrentLevelBytesPropertyInfo  ,
#endif
#if defined(ENABLE_OVERLOADING)
    dataQueueCurrentLevelBytes              ,
#endif
    getDataQueueCurrentLevelBytes           ,


-- ** currentLevelTime #attr:currentLevelTime#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    DataQueueCurrentLevelTimePropertyInfo   ,
#endif
#if defined(ENABLE_OVERLOADING)
    dataQueueCurrentLevelTime               ,
#endif
    getDataQueueCurrentLevelTime            ,


-- ** currentLevelVisible #attr:currentLevelVisible#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    DataQueueCurrentLevelVisiblePropertyInfo,
#endif
#if defined(ENABLE_OVERLOADING)
    dataQueueCurrentLevelVisible            ,
#endif
    getDataQueueCurrentLevelVisible         ,




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.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 Control.Monad.IO.Class as MIO
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

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

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

foreign import ccall "gst_data_queue_get_type"
    c_gst_data_queue_get_type :: IO B.Types.GType

instance B.Types.TypedObject DataQueue where
    glibType :: IO GType
glibType = IO GType
c_gst_data_queue_get_type

instance B.Types.GObject DataQueue

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

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

instance O.HasParentTypes DataQueue
type instance O.ParentTypes DataQueue = '[GObject.Object.Object]

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

#if defined(ENABLE_OVERLOADING)
type family ResolveDataQueueMethod (t :: Symbol) (o :: *) :: * where
    ResolveDataQueueMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveDataQueueMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveDataQueueMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveDataQueueMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveDataQueueMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveDataQueueMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveDataQueueMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveDataQueueMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveDataQueueMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveDataQueueMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveDataQueueMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveDataQueueMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveDataQueueMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveDataQueueMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveDataQueueMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveDataQueueMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveDataQueueMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveDataQueueMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveDataQueueMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveDataQueueMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveDataQueueMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveDataQueueMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveDataQueueMethod l o = O.MethodResolutionFailed l o

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

#endif

-- VVV Prop "current-level-bytes"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@current-level-bytes@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' dataQueue #currentLevelBytes
-- @
getDataQueueCurrentLevelBytes :: (MonadIO m, IsDataQueue o) => o -> m Word32
getDataQueueCurrentLevelBytes :: o -> m Word32
getDataQueueCurrentLevelBytes o
obj = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word32
forall a. GObject a => a -> String -> IO Word32
B.Properties.getObjectPropertyUInt32 o
obj String
"current-level-bytes"

#if defined(ENABLE_OVERLOADING)
data DataQueueCurrentLevelBytesPropertyInfo
instance AttrInfo DataQueueCurrentLevelBytesPropertyInfo where
    type AttrAllowedOps DataQueueCurrentLevelBytesPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint DataQueueCurrentLevelBytesPropertyInfo = IsDataQueue
    type AttrSetTypeConstraint DataQueueCurrentLevelBytesPropertyInfo = (~) ()
    type AttrTransferTypeConstraint DataQueueCurrentLevelBytesPropertyInfo = (~) ()
    type AttrTransferType DataQueueCurrentLevelBytesPropertyInfo = ()
    type AttrGetType DataQueueCurrentLevelBytesPropertyInfo = Word32
    type AttrLabel DataQueueCurrentLevelBytesPropertyInfo = "current-level-bytes"
    type AttrOrigin DataQueueCurrentLevelBytesPropertyInfo = DataQueue
    attrGet = getDataQueueCurrentLevelBytes
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

-- VVV Prop "current-level-time"
   -- Type: TBasicType TUInt64
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@current-level-time@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' dataQueue #currentLevelTime
-- @
getDataQueueCurrentLevelTime :: (MonadIO m, IsDataQueue o) => o -> m Word64
getDataQueueCurrentLevelTime :: o -> m Word64
getDataQueueCurrentLevelTime o
obj = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word64
forall a. GObject a => a -> String -> IO Word64
B.Properties.getObjectPropertyUInt64 o
obj String
"current-level-time"

#if defined(ENABLE_OVERLOADING)
data DataQueueCurrentLevelTimePropertyInfo
instance AttrInfo DataQueueCurrentLevelTimePropertyInfo where
    type AttrAllowedOps DataQueueCurrentLevelTimePropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint DataQueueCurrentLevelTimePropertyInfo = IsDataQueue
    type AttrSetTypeConstraint DataQueueCurrentLevelTimePropertyInfo = (~) ()
    type AttrTransferTypeConstraint DataQueueCurrentLevelTimePropertyInfo = (~) ()
    type AttrTransferType DataQueueCurrentLevelTimePropertyInfo = ()
    type AttrGetType DataQueueCurrentLevelTimePropertyInfo = Word64
    type AttrLabel DataQueueCurrentLevelTimePropertyInfo = "current-level-time"
    type AttrOrigin DataQueueCurrentLevelTimePropertyInfo = DataQueue
    attrGet = getDataQueueCurrentLevelTime
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

-- VVV Prop "current-level-visible"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@current-level-visible@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' dataQueue #currentLevelVisible
-- @
getDataQueueCurrentLevelVisible :: (MonadIO m, IsDataQueue o) => o -> m Word32
getDataQueueCurrentLevelVisible :: o -> m Word32
getDataQueueCurrentLevelVisible o
obj = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word32
forall a. GObject a => a -> String -> IO Word32
B.Properties.getObjectPropertyUInt32 o
obj String
"current-level-visible"

#if defined(ENABLE_OVERLOADING)
data DataQueueCurrentLevelVisiblePropertyInfo
instance AttrInfo DataQueueCurrentLevelVisiblePropertyInfo where
    type AttrAllowedOps DataQueueCurrentLevelVisiblePropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint DataQueueCurrentLevelVisiblePropertyInfo = IsDataQueue
    type AttrSetTypeConstraint DataQueueCurrentLevelVisiblePropertyInfo = (~) ()
    type AttrTransferTypeConstraint DataQueueCurrentLevelVisiblePropertyInfo = (~) ()
    type AttrTransferType DataQueueCurrentLevelVisiblePropertyInfo = ()
    type AttrGetType DataQueueCurrentLevelVisiblePropertyInfo = Word32
    type AttrLabel DataQueueCurrentLevelVisiblePropertyInfo = "current-level-visible"
    type AttrOrigin DataQueueCurrentLevelVisiblePropertyInfo = DataQueue
    attrGet = getDataQueueCurrentLevelVisible
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList DataQueue
type instance O.AttributeList DataQueue = DataQueueAttributeList
type DataQueueAttributeList = ('[ '("currentLevelBytes", DataQueueCurrentLevelBytesPropertyInfo), '("currentLevelTime", DataQueueCurrentLevelTimePropertyInfo), '("currentLevelVisible", DataQueueCurrentLevelVisiblePropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
dataQueueCurrentLevelBytes :: AttrLabelProxy "currentLevelBytes"
dataQueueCurrentLevelBytes = AttrLabelProxy

dataQueueCurrentLevelTime :: AttrLabelProxy "currentLevelTime"
dataQueueCurrentLevelTime = AttrLabelProxy

dataQueueCurrentLevelVisible :: AttrLabelProxy "currentLevelVisible"
dataQueueCurrentLevelVisible = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList DataQueue = DataQueueSignalList
type DataQueueSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif