{- |
Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
License    : LGPL-2.1
Maintainer : Iñaki García Etxebarria (garetxe@gmail.com)

Info passed in the 'GI.Gst.Callbacks.PadProbeCallback'.
-}

module GI.Gst.Structs.PadProbeInfo
    ( 

-- * Exported types
    PadProbeInfo(..)                        ,
    newZeroPadProbeInfo                     ,
    noPadProbeInfo                          ,


 -- * Methods
-- ** getBuffer #method:getBuffer#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    PadProbeInfoGetBufferMethodInfo         ,
#endif
    padProbeInfoGetBuffer                   ,


-- ** getBufferList #method:getBufferList#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    PadProbeInfoGetBufferListMethodInfo     ,
#endif
    padProbeInfoGetBufferList               ,


-- ** getEvent #method:getEvent#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    PadProbeInfoGetEventMethodInfo          ,
#endif
    padProbeInfoGetEvent                    ,


-- ** getQuery #method:getQuery#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    PadProbeInfoGetQueryMethodInfo          ,
#endif
    padProbeInfoGetQuery                    ,




 -- * Properties
-- ** data #attr:data#
    clearPadProbeInfoData                   ,
    getPadProbeInfoData                     ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    padProbeInfo_data                       ,
#endif
    setPadProbeInfoData                     ,


-- ** id #attr:id#
    getPadProbeInfoId                       ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    padProbeInfo_id                         ,
#endif
    setPadProbeInfoId                       ,


-- ** offset #attr:offset#
    getPadProbeInfoOffset                   ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    padProbeInfo_offset                     ,
#endif
    setPadProbeInfoOffset                   ,


-- ** size #attr:size#
    getPadProbeInfoSize                     ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    padProbeInfo_size                       ,
#endif
    setPadProbeInfoSize                     ,


-- ** type #attr:type#
    getPadProbeInfoType                     ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    padProbeInfo_type                       ,
#endif
    setPadProbeInfoType                     ,




    ) 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.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
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 {-# SOURCE #-} qualified GI.Gst.Flags as Gst.Flags
import {-# SOURCE #-} qualified GI.Gst.Structs.Buffer as Gst.Buffer
import {-# SOURCE #-} qualified GI.Gst.Structs.BufferList as Gst.BufferList
import {-# SOURCE #-} qualified GI.Gst.Structs.Event as Gst.Event
import {-# SOURCE #-} qualified GI.Gst.Structs.Query as Gst.Query

newtype PadProbeInfo = PadProbeInfo (ManagedPtr PadProbeInfo)
instance WrappedPtr PadProbeInfo where
    wrappedPtrCalloc = callocBytes 40
    wrappedPtrCopy = \p -> withManagedPtr p (copyBytes 40 >=> wrapPtr PadProbeInfo)
    wrappedPtrFree = Just ptr_to_g_free

-- | Construct a `PadProbeInfo` struct initialized to zero.
newZeroPadProbeInfo :: MonadIO m => m PadProbeInfo
newZeroPadProbeInfo = liftIO $ wrappedPtrCalloc >>= wrapPtr PadProbeInfo

instance tag ~ 'AttrSet => Constructible PadProbeInfo tag where
    new _ attrs = do
        o <- newZeroPadProbeInfo
        GI.Attributes.set o attrs
        return o


noPadProbeInfo :: Maybe PadProbeInfo
noPadProbeInfo = Nothing

getPadProbeInfoType :: MonadIO m => PadProbeInfo -> m [Gst.Flags.PadProbeType]
getPadProbeInfoType s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 0) :: IO CUInt
    let val' = wordToGFlags val
    return val'

setPadProbeInfoType :: MonadIO m => PadProbeInfo -> [Gst.Flags.PadProbeType] -> m ()
setPadProbeInfoType s val = liftIO $ withManagedPtr s $ \ptr -> do
    let val' = gflagsToWord val
    poke (ptr `plusPtr` 0) (val' :: CUInt)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data PadProbeInfoTypeFieldInfo
instance AttrInfo PadProbeInfoTypeFieldInfo where
    type AttrAllowedOps PadProbeInfoTypeFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint PadProbeInfoTypeFieldInfo = (~) [Gst.Flags.PadProbeType]
    type AttrBaseTypeConstraint PadProbeInfoTypeFieldInfo = (~) PadProbeInfo
    type AttrGetType PadProbeInfoTypeFieldInfo = [Gst.Flags.PadProbeType]
    type AttrLabel PadProbeInfoTypeFieldInfo = "type"
    type AttrOrigin PadProbeInfoTypeFieldInfo = PadProbeInfo
    attrGet _ = getPadProbeInfoType
    attrSet _ = setPadProbeInfoType
    attrConstruct = undefined
    attrClear _ = undefined

padProbeInfo_type :: AttrLabelProxy "type"
padProbeInfo_type = AttrLabelProxy

#endif


getPadProbeInfoId :: MonadIO m => PadProbeInfo -> m CULong
getPadProbeInfoId s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 8) :: IO CULong
    return val

setPadProbeInfoId :: MonadIO m => PadProbeInfo -> CULong -> m ()
setPadProbeInfoId s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 8) (val :: CULong)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data PadProbeInfoIdFieldInfo
instance AttrInfo PadProbeInfoIdFieldInfo where
    type AttrAllowedOps PadProbeInfoIdFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint PadProbeInfoIdFieldInfo = (~) CULong
    type AttrBaseTypeConstraint PadProbeInfoIdFieldInfo = (~) PadProbeInfo
    type AttrGetType PadProbeInfoIdFieldInfo = CULong
    type AttrLabel PadProbeInfoIdFieldInfo = "id"
    type AttrOrigin PadProbeInfoIdFieldInfo = PadProbeInfo
    attrGet _ = getPadProbeInfoId
    attrSet _ = setPadProbeInfoId
    attrConstruct = undefined
    attrClear _ = undefined

padProbeInfo_id :: AttrLabelProxy "id"
padProbeInfo_id = AttrLabelProxy

#endif


getPadProbeInfoData :: MonadIO m => PadProbeInfo -> m (Ptr ())
getPadProbeInfoData s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 16) :: IO (Ptr ())
    return val

setPadProbeInfoData :: MonadIO m => PadProbeInfo -> Ptr () -> m ()
setPadProbeInfoData s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 16) (val :: Ptr ())

clearPadProbeInfoData :: MonadIO m => PadProbeInfo -> m ()
clearPadProbeInfoData s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 16) (FP.nullPtr :: Ptr ())

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data PadProbeInfoDataFieldInfo
instance AttrInfo PadProbeInfoDataFieldInfo where
    type AttrAllowedOps PadProbeInfoDataFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint PadProbeInfoDataFieldInfo = (~) (Ptr ())
    type AttrBaseTypeConstraint PadProbeInfoDataFieldInfo = (~) PadProbeInfo
    type AttrGetType PadProbeInfoDataFieldInfo = Ptr ()
    type AttrLabel PadProbeInfoDataFieldInfo = "data"
    type AttrOrigin PadProbeInfoDataFieldInfo = PadProbeInfo
    attrGet _ = getPadProbeInfoData
    attrSet _ = setPadProbeInfoData
    attrConstruct = undefined
    attrClear _ = clearPadProbeInfoData

padProbeInfo_data :: AttrLabelProxy "data"
padProbeInfo_data = AttrLabelProxy

#endif


getPadProbeInfoOffset :: MonadIO m => PadProbeInfo -> m Word64
getPadProbeInfoOffset s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 24) :: IO Word64
    return val

setPadProbeInfoOffset :: MonadIO m => PadProbeInfo -> Word64 -> m ()
setPadProbeInfoOffset s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 24) (val :: Word64)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data PadProbeInfoOffsetFieldInfo
instance AttrInfo PadProbeInfoOffsetFieldInfo where
    type AttrAllowedOps PadProbeInfoOffsetFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint PadProbeInfoOffsetFieldInfo = (~) Word64
    type AttrBaseTypeConstraint PadProbeInfoOffsetFieldInfo = (~) PadProbeInfo
    type AttrGetType PadProbeInfoOffsetFieldInfo = Word64
    type AttrLabel PadProbeInfoOffsetFieldInfo = "offset"
    type AttrOrigin PadProbeInfoOffsetFieldInfo = PadProbeInfo
    attrGet _ = getPadProbeInfoOffset
    attrSet _ = setPadProbeInfoOffset
    attrConstruct = undefined
    attrClear _ = undefined

padProbeInfo_offset :: AttrLabelProxy "offset"
padProbeInfo_offset = AttrLabelProxy

#endif


getPadProbeInfoSize :: MonadIO m => PadProbeInfo -> m Word32
getPadProbeInfoSize s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 32) :: IO Word32
    return val

setPadProbeInfoSize :: MonadIO m => PadProbeInfo -> Word32 -> m ()
setPadProbeInfoSize s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 32) (val :: Word32)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data PadProbeInfoSizeFieldInfo
instance AttrInfo PadProbeInfoSizeFieldInfo where
    type AttrAllowedOps PadProbeInfoSizeFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint PadProbeInfoSizeFieldInfo = (~) Word32
    type AttrBaseTypeConstraint PadProbeInfoSizeFieldInfo = (~) PadProbeInfo
    type AttrGetType PadProbeInfoSizeFieldInfo = Word32
    type AttrLabel PadProbeInfoSizeFieldInfo = "size"
    type AttrOrigin PadProbeInfoSizeFieldInfo = PadProbeInfo
    attrGet _ = getPadProbeInfoSize
    attrSet _ = setPadProbeInfoSize
    attrConstruct = undefined
    attrClear _ = undefined

padProbeInfo_size :: AttrLabelProxy "size"
padProbeInfo_size = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
instance O.HasAttributeList PadProbeInfo
type instance O.AttributeList PadProbeInfo = PadProbeInfoAttributeList
type PadProbeInfoAttributeList = ('[ '("type", PadProbeInfoTypeFieldInfo), '("id", PadProbeInfoIdFieldInfo), '("data", PadProbeInfoDataFieldInfo), '("offset", PadProbeInfoOffsetFieldInfo), '("size", PadProbeInfoSizeFieldInfo)] :: [(Symbol, *)])
#endif

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

foreign import ccall "gst_pad_probe_info_get_buffer" gst_pad_probe_info_get_buffer :: 
    Ptr PadProbeInfo ->                     -- info : TInterface (Name {namespace = "Gst", name = "PadProbeInfo"})
    IO (Ptr Gst.Buffer.Buffer)

{- |
/No description available in the introspection data./
-}
padProbeInfoGetBuffer ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PadProbeInfo
    {- ^ /@info@/: a 'GI.Gst.Structs.PadProbeInfo.PadProbeInfo' -}
    -> m Gst.Buffer.Buffer
    {- ^ __Returns:__ The 'GI.Gst.Structs.Buffer.Buffer' from the probe -}
padProbeInfoGetBuffer info = liftIO $ do
    info' <- unsafeManagedPtrGetPtr info
    result <- gst_pad_probe_info_get_buffer info'
    checkUnexpectedReturnNULL "padProbeInfoGetBuffer" result
    result' <- (newBoxed Gst.Buffer.Buffer) result
    touchManagedPtr info
    return result'

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data PadProbeInfoGetBufferMethodInfo
instance (signature ~ (m Gst.Buffer.Buffer), MonadIO m) => O.MethodInfo PadProbeInfoGetBufferMethodInfo PadProbeInfo signature where
    overloadedMethod _ = padProbeInfoGetBuffer

#endif

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

foreign import ccall "gst_pad_probe_info_get_buffer_list" gst_pad_probe_info_get_buffer_list :: 
    Ptr PadProbeInfo ->                     -- info : TInterface (Name {namespace = "Gst", name = "PadProbeInfo"})
    IO (Ptr Gst.BufferList.BufferList)

{- |
/No description available in the introspection data./
-}
padProbeInfoGetBufferList ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PadProbeInfo
    {- ^ /@info@/: a 'GI.Gst.Structs.PadProbeInfo.PadProbeInfo' -}
    -> m Gst.BufferList.BufferList
    {- ^ __Returns:__ The 'GI.Gst.Structs.BufferList.BufferList' from the probe -}
padProbeInfoGetBufferList info = liftIO $ do
    info' <- unsafeManagedPtrGetPtr info
    result <- gst_pad_probe_info_get_buffer_list info'
    checkUnexpectedReturnNULL "padProbeInfoGetBufferList" result
    result' <- (newBoxed Gst.BufferList.BufferList) result
    touchManagedPtr info
    return result'

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data PadProbeInfoGetBufferListMethodInfo
instance (signature ~ (m Gst.BufferList.BufferList), MonadIO m) => O.MethodInfo PadProbeInfoGetBufferListMethodInfo PadProbeInfo signature where
    overloadedMethod _ = padProbeInfoGetBufferList

#endif

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

foreign import ccall "gst_pad_probe_info_get_event" gst_pad_probe_info_get_event :: 
    Ptr PadProbeInfo ->                     -- info : TInterface (Name {namespace = "Gst", name = "PadProbeInfo"})
    IO (Ptr Gst.Event.Event)

{- |
/No description available in the introspection data./
-}
padProbeInfoGetEvent ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PadProbeInfo
    {- ^ /@info@/: a 'GI.Gst.Structs.PadProbeInfo.PadProbeInfo' -}
    -> m Gst.Event.Event
    {- ^ __Returns:__ The 'GI.Gst.Structs.Event.Event' from the probe -}
padProbeInfoGetEvent info = liftIO $ do
    info' <- unsafeManagedPtrGetPtr info
    result <- gst_pad_probe_info_get_event info'
    checkUnexpectedReturnNULL "padProbeInfoGetEvent" result
    result' <- (newBoxed Gst.Event.Event) result
    touchManagedPtr info
    return result'

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data PadProbeInfoGetEventMethodInfo
instance (signature ~ (m Gst.Event.Event), MonadIO m) => O.MethodInfo PadProbeInfoGetEventMethodInfo PadProbeInfo signature where
    overloadedMethod _ = padProbeInfoGetEvent

#endif

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

foreign import ccall "gst_pad_probe_info_get_query" gst_pad_probe_info_get_query :: 
    Ptr PadProbeInfo ->                     -- info : TInterface (Name {namespace = "Gst", name = "PadProbeInfo"})
    IO (Ptr Gst.Query.Query)

{- |
/No description available in the introspection data./
-}
padProbeInfoGetQuery ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PadProbeInfo
    {- ^ /@info@/: a 'GI.Gst.Structs.PadProbeInfo.PadProbeInfo' -}
    -> m Gst.Query.Query
    {- ^ __Returns:__ The 'GI.Gst.Structs.Query.Query' from the probe -}
padProbeInfoGetQuery info = liftIO $ do
    info' <- unsafeManagedPtrGetPtr info
    result <- gst_pad_probe_info_get_query info'
    checkUnexpectedReturnNULL "padProbeInfoGetQuery" result
    result' <- (newBoxed Gst.Query.Query) result
    touchManagedPtr info
    return result'

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data PadProbeInfoGetQueryMethodInfo
instance (signature ~ (m Gst.Query.Query), MonadIO m) => O.MethodInfo PadProbeInfoGetQueryMethodInfo PadProbeInfo signature where
    overloadedMethod _ = padProbeInfoGetQuery

#endif

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
type family ResolvePadProbeInfoMethod (t :: Symbol) (o :: *) :: * where
    ResolvePadProbeInfoMethod "getBuffer" o = PadProbeInfoGetBufferMethodInfo
    ResolvePadProbeInfoMethod "getBufferList" o = PadProbeInfoGetBufferListMethodInfo
    ResolvePadProbeInfoMethod "getEvent" o = PadProbeInfoGetEventMethodInfo
    ResolvePadProbeInfoMethod "getQuery" o = PadProbeInfoGetQueryMethodInfo
    ResolvePadProbeInfoMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolvePadProbeInfoMethod t PadProbeInfo, O.MethodInfo info PadProbeInfo p) => O.IsLabelProxy t (PadProbeInfo -> p) where
    fromLabelProxy _ = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)

#if MIN_VERSION_base(4,9,0)
instance (info ~ ResolvePadProbeInfoMethod t PadProbeInfo, O.MethodInfo info PadProbeInfo p) => O.IsLabel t (PadProbeInfo -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)
#else
    fromLabel _ = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)
#endif
#endif

#endif