{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Frame (context) data passed to each frame parsing virtual methods.  In
-- addition to providing the data to be checked for a valid frame or an already
-- identified frame, it conveys additional metadata or control information
-- from and to the subclass w.r.t. the particular frame in question (rather
-- than global parameters).  Some of these may apply to each parsing stage, others
-- only to some a particular one.  These parameters are effectively zeroed at start
-- of each frame\'s processing, i.e. parsing virtual method invocation sequence.

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

module GI.GstBase.Structs.BaseParseFrame
    ( 

-- * Exported types
    BaseParseFrame(..)                      ,
    newZeroBaseParseFrame                   ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [copy]("GI.GstBase.Structs.BaseParseFrame#g:method:copy"), [free]("GI.GstBase.Structs.BaseParseFrame#g:method:free"), [init]("GI.GstBase.Structs.BaseParseFrame#g:method:init").
-- 
-- ==== Getters
-- /None/.
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveBaseParseFrameMethod             ,
#endif

-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    BaseParseFrameCopyMethodInfo            ,
#endif
    baseParseFrameCopy                      ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    BaseParseFrameFreeMethodInfo            ,
#endif
    baseParseFrameFree                      ,


-- ** init #method:init#

#if defined(ENABLE_OVERLOADING)
    BaseParseFrameInitMethodInfo            ,
#endif
    baseParseFrameInit                      ,


-- ** new #method:new#

    baseParseFrameNew                       ,




 -- * Properties


-- ** buffer #attr:buffer#
-- | input data to be parsed for frames.

#if defined(ENABLE_OVERLOADING)
    baseParseFrame_buffer                   ,
#endif
    clearBaseParseFrameBuffer               ,
    getBaseParseFrameBuffer                 ,
    setBaseParseFrameBuffer                 ,


-- ** flags #attr:flags#
-- | a combination of input and output t'GI.GstBase.Flags.BaseParseFrameFlags' that
--  convey additional context to subclass or allow subclass to tune
--  subsequent t'GI.GstBase.Objects.BaseParse.BaseParse' actions.

#if defined(ENABLE_OVERLOADING)
    baseParseFrame_flags                    ,
#endif
    getBaseParseFrameFlags                  ,
    setBaseParseFrameFlags                  ,


-- ** offset #attr:offset#
-- | media specific offset of input frame
--   Note that a converter may have a different one on the frame\'s buffer.

#if defined(ENABLE_OVERLOADING)
    baseParseFrame_offset                   ,
#endif
    getBaseParseFrameOffset                 ,
    setBaseParseFrameOffset                 ,


-- ** outBuffer #attr:outBuffer#
-- | output data.

#if defined(ENABLE_OVERLOADING)
    baseParseFrame_outBuffer                ,
#endif
    clearBaseParseFrameOutBuffer            ,
    getBaseParseFrameOutBuffer              ,
    setBaseParseFrameOutBuffer              ,


-- ** overhead #attr:overhead#
-- | subclass can set this to indicates the metadata overhead
--   for the given frame, which is then used to enable more accurate bitrate
--   computations. If this is -1, it is assumed that this frame should be
--   skipped in bitrate calculation.

#if defined(ENABLE_OVERLOADING)
    baseParseFrame_overhead                 ,
#endif
    getBaseParseFrameOverhead               ,
    setBaseParseFrameOverhead               ,




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

import qualified GI.Gst.Structs.Buffer as Gst.Buffer
import {-# SOURCE #-} qualified GI.GstBase.Flags as GstBase.Flags

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

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

foreign import ccall "gst_base_parse_frame_get_type" c_gst_base_parse_frame_get_type :: 
    IO GType

type instance O.ParentTypes BaseParseFrame = '[]
instance O.HasParentTypes BaseParseFrame

instance B.Types.TypedObject BaseParseFrame where
    glibType :: IO GType
glibType = IO GType
c_gst_base_parse_frame_get_type

instance B.Types.GBoxed BaseParseFrame

-- | Convert 'BaseParseFrame' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe BaseParseFrame) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gst_base_parse_frame_get_type
    gvalueSet_ :: Ptr GValue -> Maybe BaseParseFrame -> IO ()
gvalueSet_ Ptr GValue
gv Maybe BaseParseFrame
P.Nothing = Ptr GValue -> Ptr BaseParseFrame -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv (Ptr BaseParseFrame
forall a. Ptr a
FP.nullPtr :: FP.Ptr BaseParseFrame)
    gvalueSet_ Ptr GValue
gv (P.Just BaseParseFrame
obj) = BaseParseFrame -> (Ptr BaseParseFrame -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr BaseParseFrame
obj (Ptr GValue -> Ptr BaseParseFrame -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe BaseParseFrame)
gvalueGet_ Ptr GValue
gv = do
        Ptr BaseParseFrame
ptr <- Ptr GValue -> IO (Ptr BaseParseFrame)
forall b. Ptr GValue -> IO (Ptr b)
B.GValue.get_boxed Ptr GValue
gv :: IO (Ptr BaseParseFrame)
        if Ptr BaseParseFrame
ptr Ptr BaseParseFrame -> Ptr BaseParseFrame -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr BaseParseFrame
forall a. Ptr a
FP.nullPtr
        then BaseParseFrame -> Maybe BaseParseFrame
forall a. a -> Maybe a
P.Just (BaseParseFrame -> Maybe BaseParseFrame)
-> IO BaseParseFrame -> IO (Maybe BaseParseFrame)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr BaseParseFrame -> BaseParseFrame)
-> Ptr BaseParseFrame -> IO BaseParseFrame
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr BaseParseFrame -> BaseParseFrame
BaseParseFrame Ptr BaseParseFrame
ptr
        else Maybe BaseParseFrame -> IO (Maybe BaseParseFrame)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe BaseParseFrame
forall a. Maybe a
P.Nothing
        
    

-- | Construct a `BaseParseFrame` struct initialized to zero.
newZeroBaseParseFrame :: MonadIO m => m BaseParseFrame
newZeroBaseParseFrame :: forall (m :: * -> *). MonadIO m => m BaseParseFrame
newZeroBaseParseFrame = IO BaseParseFrame -> m BaseParseFrame
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BaseParseFrame -> m BaseParseFrame)
-> IO BaseParseFrame -> m BaseParseFrame
forall a b. (a -> b) -> a -> b
$ Int -> IO (Ptr BaseParseFrame)
forall a. GBoxed a => Int -> IO (Ptr a)
callocBoxedBytes Int
72 IO (Ptr BaseParseFrame)
-> (Ptr BaseParseFrame -> IO BaseParseFrame) -> IO BaseParseFrame
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr BaseParseFrame -> BaseParseFrame)
-> Ptr BaseParseFrame -> IO BaseParseFrame
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseParseFrame -> BaseParseFrame
BaseParseFrame

instance tag ~ 'AttrSet => Constructible BaseParseFrame tag where
    new :: forall (m :: * -> *).
MonadIO m =>
(ManagedPtr BaseParseFrame -> BaseParseFrame)
-> [AttrOp BaseParseFrame tag] -> m BaseParseFrame
new ManagedPtr BaseParseFrame -> BaseParseFrame
_ [AttrOp BaseParseFrame tag]
attrs = do
        BaseParseFrame
o <- m BaseParseFrame
forall (m :: * -> *). MonadIO m => m BaseParseFrame
newZeroBaseParseFrame
        BaseParseFrame -> [AttrOp BaseParseFrame 'AttrSet] -> m ()
forall o (m :: * -> *).
MonadIO m =>
o -> [AttrOp o 'AttrSet] -> m ()
GI.Attributes.set BaseParseFrame
o [AttrOp BaseParseFrame tag]
[AttrOp BaseParseFrame 'AttrSet]
attrs
        BaseParseFrame -> m BaseParseFrame
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseParseFrame
o


-- | Get the value of the “@buffer@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' baseParseFrame #buffer
-- @
getBaseParseFrameBuffer :: MonadIO m => BaseParseFrame -> m (Maybe Gst.Buffer.Buffer)
getBaseParseFrameBuffer :: forall (m :: * -> *).
MonadIO m =>
BaseParseFrame -> m (Maybe Buffer)
getBaseParseFrameBuffer BaseParseFrame
s = IO (Maybe Buffer) -> m (Maybe Buffer)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Buffer) -> m (Maybe Buffer))
-> IO (Maybe Buffer) -> m (Maybe Buffer)
forall a b. (a -> b) -> a -> b
$ BaseParseFrame
-> (Ptr BaseParseFrame -> IO (Maybe Buffer)) -> IO (Maybe Buffer)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr BaseParseFrame
s ((Ptr BaseParseFrame -> IO (Maybe Buffer)) -> IO (Maybe Buffer))
-> (Ptr BaseParseFrame -> IO (Maybe Buffer)) -> IO (Maybe Buffer)
forall a b. (a -> b) -> a -> b
$ \Ptr BaseParseFrame
ptr -> do
    Ptr Buffer
val <- Ptr (Ptr Buffer) -> IO (Ptr Buffer)
forall a. Storable a => Ptr a -> IO a
peek (Ptr BaseParseFrame
ptr Ptr BaseParseFrame -> Int -> Ptr (Ptr Buffer)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) :: IO (Ptr Gst.Buffer.Buffer)
    Maybe Buffer
result <- Ptr Buffer -> (Ptr Buffer -> IO Buffer) -> IO (Maybe Buffer)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull Ptr Buffer
val ((Ptr Buffer -> IO Buffer) -> IO (Maybe Buffer))
-> (Ptr Buffer -> IO Buffer) -> IO (Maybe Buffer)
forall a b. (a -> b) -> a -> b
$ \Ptr Buffer
val' -> do
        Buffer
val'' <- ((ManagedPtr Buffer -> Buffer) -> Ptr Buffer -> IO Buffer
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Buffer -> Buffer
Gst.Buffer.Buffer) Ptr Buffer
val'
        Buffer -> IO Buffer
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer
val''
    Maybe Buffer -> IO (Maybe Buffer)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Buffer
result

-- | Set the value of the “@buffer@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' baseParseFrame [ #buffer 'Data.GI.Base.Attributes.:=' value ]
-- @
setBaseParseFrameBuffer :: MonadIO m => BaseParseFrame -> Ptr Gst.Buffer.Buffer -> m ()
setBaseParseFrameBuffer :: forall (m :: * -> *).
MonadIO m =>
BaseParseFrame -> Ptr Buffer -> m ()
setBaseParseFrameBuffer BaseParseFrame
s Ptr Buffer
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ BaseParseFrame -> (Ptr BaseParseFrame -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr BaseParseFrame
s ((Ptr BaseParseFrame -> IO ()) -> IO ())
-> (Ptr BaseParseFrame -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr BaseParseFrame
ptr -> do
    Ptr (Ptr Buffer) -> Ptr Buffer -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr BaseParseFrame
ptr Ptr BaseParseFrame -> Int -> Ptr (Ptr Buffer)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (Ptr Buffer
val :: Ptr Gst.Buffer.Buffer)

-- | Set the value of the “@buffer@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #buffer
-- @
clearBaseParseFrameBuffer :: MonadIO m => BaseParseFrame -> m ()
clearBaseParseFrameBuffer :: forall (m :: * -> *). MonadIO m => BaseParseFrame -> m ()
clearBaseParseFrameBuffer BaseParseFrame
s = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ BaseParseFrame -> (Ptr BaseParseFrame -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr BaseParseFrame
s ((Ptr BaseParseFrame -> IO ()) -> IO ())
-> (Ptr BaseParseFrame -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr BaseParseFrame
ptr -> do
    Ptr (Ptr Buffer) -> Ptr Buffer -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr BaseParseFrame
ptr Ptr BaseParseFrame -> Int -> Ptr (Ptr Buffer)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (Ptr Buffer
forall a. Ptr a
FP.nullPtr :: Ptr Gst.Buffer.Buffer)

#if defined(ENABLE_OVERLOADING)
data BaseParseFrameBufferFieldInfo
instance AttrInfo BaseParseFrameBufferFieldInfo where
    type AttrBaseTypeConstraint BaseParseFrameBufferFieldInfo = (~) BaseParseFrame
    type AttrAllowedOps BaseParseFrameBufferFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint BaseParseFrameBufferFieldInfo = (~) (Ptr Gst.Buffer.Buffer)
    type AttrTransferTypeConstraint BaseParseFrameBufferFieldInfo = (~)(Ptr Gst.Buffer.Buffer)
    type AttrTransferType BaseParseFrameBufferFieldInfo = (Ptr Gst.Buffer.Buffer)
    type AttrGetType BaseParseFrameBufferFieldInfo = Maybe Gst.Buffer.Buffer
    type AttrLabel BaseParseFrameBufferFieldInfo = "buffer"
    type AttrOrigin BaseParseFrameBufferFieldInfo = BaseParseFrame
    attrGet = getBaseParseFrameBuffer
    attrSet = setBaseParseFrameBuffer
    attrConstruct = undefined
    attrClear = clearBaseParseFrameBuffer
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstBase.Structs.BaseParseFrame.buffer"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstbase-1.0.26/docs/GI-GstBase-Structs-BaseParseFrame.html#g:attr:buffer"
        })

baseParseFrame_buffer :: AttrLabelProxy "buffer"
baseParseFrame_buffer = AttrLabelProxy

#endif


-- | Get the value of the “@out_buffer@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' baseParseFrame #outBuffer
-- @
getBaseParseFrameOutBuffer :: MonadIO m => BaseParseFrame -> m (Maybe Gst.Buffer.Buffer)
getBaseParseFrameOutBuffer :: forall (m :: * -> *).
MonadIO m =>
BaseParseFrame -> m (Maybe Buffer)
getBaseParseFrameOutBuffer BaseParseFrame
s = IO (Maybe Buffer) -> m (Maybe Buffer)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Buffer) -> m (Maybe Buffer))
-> IO (Maybe Buffer) -> m (Maybe Buffer)
forall a b. (a -> b) -> a -> b
$ BaseParseFrame
-> (Ptr BaseParseFrame -> IO (Maybe Buffer)) -> IO (Maybe Buffer)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr BaseParseFrame
s ((Ptr BaseParseFrame -> IO (Maybe Buffer)) -> IO (Maybe Buffer))
-> (Ptr BaseParseFrame -> IO (Maybe Buffer)) -> IO (Maybe Buffer)
forall a b. (a -> b) -> a -> b
$ \Ptr BaseParseFrame
ptr -> do
    Ptr Buffer
val <- Ptr (Ptr Buffer) -> IO (Ptr Buffer)
forall a. Storable a => Ptr a -> IO a
peek (Ptr BaseParseFrame
ptr Ptr BaseParseFrame -> Int -> Ptr (Ptr Buffer)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) :: IO (Ptr Gst.Buffer.Buffer)
    Maybe Buffer
result <- Ptr Buffer -> (Ptr Buffer -> IO Buffer) -> IO (Maybe Buffer)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull Ptr Buffer
val ((Ptr Buffer -> IO Buffer) -> IO (Maybe Buffer))
-> (Ptr Buffer -> IO Buffer) -> IO (Maybe Buffer)
forall a b. (a -> b) -> a -> b
$ \Ptr Buffer
val' -> do
        Buffer
val'' <- ((ManagedPtr Buffer -> Buffer) -> Ptr Buffer -> IO Buffer
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Buffer -> Buffer
Gst.Buffer.Buffer) Ptr Buffer
val'
        Buffer -> IO Buffer
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer
val''
    Maybe Buffer -> IO (Maybe Buffer)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Buffer
result

-- | Set the value of the “@out_buffer@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' baseParseFrame [ #outBuffer 'Data.GI.Base.Attributes.:=' value ]
-- @
setBaseParseFrameOutBuffer :: MonadIO m => BaseParseFrame -> Ptr Gst.Buffer.Buffer -> m ()
setBaseParseFrameOutBuffer :: forall (m :: * -> *).
MonadIO m =>
BaseParseFrame -> Ptr Buffer -> m ()
setBaseParseFrameOutBuffer BaseParseFrame
s Ptr Buffer
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ BaseParseFrame -> (Ptr BaseParseFrame -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr BaseParseFrame
s ((Ptr BaseParseFrame -> IO ()) -> IO ())
-> (Ptr BaseParseFrame -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr BaseParseFrame
ptr -> do
    Ptr (Ptr Buffer) -> Ptr Buffer -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr BaseParseFrame
ptr Ptr BaseParseFrame -> Int -> Ptr (Ptr Buffer)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (Ptr Buffer
val :: Ptr Gst.Buffer.Buffer)

-- | Set the value of the “@out_buffer@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #outBuffer
-- @
clearBaseParseFrameOutBuffer :: MonadIO m => BaseParseFrame -> m ()
clearBaseParseFrameOutBuffer :: forall (m :: * -> *). MonadIO m => BaseParseFrame -> m ()
clearBaseParseFrameOutBuffer BaseParseFrame
s = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ BaseParseFrame -> (Ptr BaseParseFrame -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr BaseParseFrame
s ((Ptr BaseParseFrame -> IO ()) -> IO ())
-> (Ptr BaseParseFrame -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr BaseParseFrame
ptr -> do
    Ptr (Ptr Buffer) -> Ptr Buffer -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr BaseParseFrame
ptr Ptr BaseParseFrame -> Int -> Ptr (Ptr Buffer)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (Ptr Buffer
forall a. Ptr a
FP.nullPtr :: Ptr Gst.Buffer.Buffer)

#if defined(ENABLE_OVERLOADING)
data BaseParseFrameOutBufferFieldInfo
instance AttrInfo BaseParseFrameOutBufferFieldInfo where
    type AttrBaseTypeConstraint BaseParseFrameOutBufferFieldInfo = (~) BaseParseFrame
    type AttrAllowedOps BaseParseFrameOutBufferFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint BaseParseFrameOutBufferFieldInfo = (~) (Ptr Gst.Buffer.Buffer)
    type AttrTransferTypeConstraint BaseParseFrameOutBufferFieldInfo = (~)(Ptr Gst.Buffer.Buffer)
    type AttrTransferType BaseParseFrameOutBufferFieldInfo = (Ptr Gst.Buffer.Buffer)
    type AttrGetType BaseParseFrameOutBufferFieldInfo = Maybe Gst.Buffer.Buffer
    type AttrLabel BaseParseFrameOutBufferFieldInfo = "out_buffer"
    type AttrOrigin BaseParseFrameOutBufferFieldInfo = BaseParseFrame
    attrGet = getBaseParseFrameOutBuffer
    attrSet = setBaseParseFrameOutBuffer
    attrConstruct = undefined
    attrClear = clearBaseParseFrameOutBuffer
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstBase.Structs.BaseParseFrame.outBuffer"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstbase-1.0.26/docs/GI-GstBase-Structs-BaseParseFrame.html#g:attr:outBuffer"
        })

baseParseFrame_outBuffer :: AttrLabelProxy "outBuffer"
baseParseFrame_outBuffer = AttrLabelProxy

#endif


-- | Get the value of the “@flags@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' baseParseFrame #flags
-- @
getBaseParseFrameFlags :: MonadIO m => BaseParseFrame -> m Word32
getBaseParseFrameFlags :: forall (m :: * -> *). MonadIO m => BaseParseFrame -> m Word32
getBaseParseFrameFlags BaseParseFrame
s = IO Word32 -> m Word32
forall a. IO a -> m a
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
$ BaseParseFrame -> (Ptr BaseParseFrame -> IO Word32) -> IO Word32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr BaseParseFrame
s ((Ptr BaseParseFrame -> IO Word32) -> IO Word32)
-> (Ptr BaseParseFrame -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ \Ptr BaseParseFrame
ptr -> do
    Word32
val <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek (Ptr BaseParseFrame
ptr Ptr BaseParseFrame -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) :: IO Word32
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
val

-- | Set the value of the “@flags@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' baseParseFrame [ #flags 'Data.GI.Base.Attributes.:=' value ]
-- @
setBaseParseFrameFlags :: MonadIO m => BaseParseFrame -> Word32 -> m ()
setBaseParseFrameFlags :: forall (m :: * -> *). MonadIO m => BaseParseFrame -> Word32 -> m ()
setBaseParseFrameFlags BaseParseFrame
s Word32
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ BaseParseFrame -> (Ptr BaseParseFrame -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr BaseParseFrame
s ((Ptr BaseParseFrame -> IO ()) -> IO ())
-> (Ptr BaseParseFrame -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr BaseParseFrame
ptr -> do
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr BaseParseFrame
ptr Ptr BaseParseFrame -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) (Word32
val :: Word32)

#if defined(ENABLE_OVERLOADING)
data BaseParseFrameFlagsFieldInfo
instance AttrInfo BaseParseFrameFlagsFieldInfo where
    type AttrBaseTypeConstraint BaseParseFrameFlagsFieldInfo = (~) BaseParseFrame
    type AttrAllowedOps BaseParseFrameFlagsFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint BaseParseFrameFlagsFieldInfo = (~) Word32
    type AttrTransferTypeConstraint BaseParseFrameFlagsFieldInfo = (~)Word32
    type AttrTransferType BaseParseFrameFlagsFieldInfo = Word32
    type AttrGetType BaseParseFrameFlagsFieldInfo = Word32
    type AttrLabel BaseParseFrameFlagsFieldInfo = "flags"
    type AttrOrigin BaseParseFrameFlagsFieldInfo = BaseParseFrame
    attrGet = getBaseParseFrameFlags
    attrSet = setBaseParseFrameFlags
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstBase.Structs.BaseParseFrame.flags"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstbase-1.0.26/docs/GI-GstBase-Structs-BaseParseFrame.html#g:attr:flags"
        })

baseParseFrame_flags :: AttrLabelProxy "flags"
baseParseFrame_flags = AttrLabelProxy

#endif


-- | Get the value of the “@offset@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' baseParseFrame #offset
-- @
getBaseParseFrameOffset :: MonadIO m => BaseParseFrame -> m Word64
getBaseParseFrameOffset :: forall (m :: * -> *). MonadIO m => BaseParseFrame -> m Word64
getBaseParseFrameOffset BaseParseFrame
s = IO Word64 -> m Word64
forall a. IO a -> m a
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
$ BaseParseFrame -> (Ptr BaseParseFrame -> IO Word64) -> IO Word64
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr BaseParseFrame
s ((Ptr BaseParseFrame -> IO Word64) -> IO Word64)
-> (Ptr BaseParseFrame -> IO Word64) -> IO Word64
forall a b. (a -> b) -> a -> b
$ \Ptr BaseParseFrame
ptr -> do
    Word64
val <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek (Ptr BaseParseFrame
ptr Ptr BaseParseFrame -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) :: IO Word64
    Word64 -> IO Word64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
val

-- | Set the value of the “@offset@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' baseParseFrame [ #offset 'Data.GI.Base.Attributes.:=' value ]
-- @
setBaseParseFrameOffset :: MonadIO m => BaseParseFrame -> Word64 -> m ()
setBaseParseFrameOffset :: forall (m :: * -> *). MonadIO m => BaseParseFrame -> Word64 -> m ()
setBaseParseFrameOffset BaseParseFrame
s Word64
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ BaseParseFrame -> (Ptr BaseParseFrame -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr BaseParseFrame
s ((Ptr BaseParseFrame -> IO ()) -> IO ())
-> (Ptr BaseParseFrame -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr BaseParseFrame
ptr -> do
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr BaseParseFrame
ptr Ptr BaseParseFrame -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) (Word64
val :: Word64)

#if defined(ENABLE_OVERLOADING)
data BaseParseFrameOffsetFieldInfo
instance AttrInfo BaseParseFrameOffsetFieldInfo where
    type AttrBaseTypeConstraint BaseParseFrameOffsetFieldInfo = (~) BaseParseFrame
    type AttrAllowedOps BaseParseFrameOffsetFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint BaseParseFrameOffsetFieldInfo = (~) Word64
    type AttrTransferTypeConstraint BaseParseFrameOffsetFieldInfo = (~)Word64
    type AttrTransferType BaseParseFrameOffsetFieldInfo = Word64
    type AttrGetType BaseParseFrameOffsetFieldInfo = Word64
    type AttrLabel BaseParseFrameOffsetFieldInfo = "offset"
    type AttrOrigin BaseParseFrameOffsetFieldInfo = BaseParseFrame
    attrGet = getBaseParseFrameOffset
    attrSet = setBaseParseFrameOffset
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstBase.Structs.BaseParseFrame.offset"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstbase-1.0.26/docs/GI-GstBase-Structs-BaseParseFrame.html#g:attr:offset"
        })

baseParseFrame_offset :: AttrLabelProxy "offset"
baseParseFrame_offset = AttrLabelProxy

#endif


-- | Get the value of the “@overhead@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' baseParseFrame #overhead
-- @
getBaseParseFrameOverhead :: MonadIO m => BaseParseFrame -> m Int32
getBaseParseFrameOverhead :: forall (m :: * -> *). MonadIO m => BaseParseFrame -> m Int32
getBaseParseFrameOverhead BaseParseFrame
s = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ BaseParseFrame -> (Ptr BaseParseFrame -> IO Int32) -> IO Int32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr BaseParseFrame
s ((Ptr BaseParseFrame -> IO Int32) -> IO Int32)
-> (Ptr BaseParseFrame -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ \Ptr BaseParseFrame
ptr -> do
    Int32
val <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek (Ptr BaseParseFrame
ptr Ptr BaseParseFrame -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32) :: IO Int32
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
val

-- | Set the value of the “@overhead@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' baseParseFrame [ #overhead 'Data.GI.Base.Attributes.:=' value ]
-- @
setBaseParseFrameOverhead :: MonadIO m => BaseParseFrame -> Int32 -> m ()
setBaseParseFrameOverhead :: forall (m :: * -> *). MonadIO m => BaseParseFrame -> Int32 -> m ()
setBaseParseFrameOverhead BaseParseFrame
s Int32
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ BaseParseFrame -> (Ptr BaseParseFrame -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr BaseParseFrame
s ((Ptr BaseParseFrame -> IO ()) -> IO ())
-> (Ptr BaseParseFrame -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr BaseParseFrame
ptr -> do
    Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr BaseParseFrame
ptr Ptr BaseParseFrame -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32) (Int32
val :: Int32)

#if defined(ENABLE_OVERLOADING)
data BaseParseFrameOverheadFieldInfo
instance AttrInfo BaseParseFrameOverheadFieldInfo where
    type AttrBaseTypeConstraint BaseParseFrameOverheadFieldInfo = (~) BaseParseFrame
    type AttrAllowedOps BaseParseFrameOverheadFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint BaseParseFrameOverheadFieldInfo = (~) Int32
    type AttrTransferTypeConstraint BaseParseFrameOverheadFieldInfo = (~)Int32
    type AttrTransferType BaseParseFrameOverheadFieldInfo = Int32
    type AttrGetType BaseParseFrameOverheadFieldInfo = Int32
    type AttrLabel BaseParseFrameOverheadFieldInfo = "overhead"
    type AttrOrigin BaseParseFrameOverheadFieldInfo = BaseParseFrame
    attrGet = getBaseParseFrameOverhead
    attrSet = setBaseParseFrameOverhead
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstBase.Structs.BaseParseFrame.overhead"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstbase-1.0.26/docs/GI-GstBase-Structs-BaseParseFrame.html#g:attr:overhead"
        })

baseParseFrame_overhead :: AttrLabelProxy "overhead"
baseParseFrame_overhead = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList BaseParseFrame
type instance O.AttributeList BaseParseFrame = BaseParseFrameAttributeList
type BaseParseFrameAttributeList = ('[ '("buffer", BaseParseFrameBufferFieldInfo), '("outBuffer", BaseParseFrameOutBufferFieldInfo), '("flags", BaseParseFrameFlagsFieldInfo), '("offset", BaseParseFrameOffsetFieldInfo), '("overhead", BaseParseFrameOverheadFieldInfo)] :: [(Symbol, *)])
#endif

-- method BaseParseFrame::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "buffer"
--           , argType = TInterface Name { namespace = "Gst" , name = "Buffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBuffer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name { namespace = "GstBase" , name = "BaseParseFrameFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the flags" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "overhead"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "number of bytes in this frame which should be counted as\n    metadata overhead, ie. not used to calculate the average bitrate.\n    Set to -1 to mark the entire frame as metadata. If in doubt, set to 0."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GstBase" , name = "BaseParseFrame" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_base_parse_frame_new" gst_base_parse_frame_new :: 
    Ptr Gst.Buffer.Buffer ->                -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "GstBase", name = "BaseParseFrameFlags"})
    Int32 ->                                -- overhead : TBasicType TInt
    IO (Ptr BaseParseFrame)

-- | Allocates a new t'GI.GstBase.Structs.BaseParseFrame.BaseParseFrame'. This function is mainly for bindings,
-- elements written in C should usually allocate the frame on the stack and
-- then use 'GI.GstBase.Structs.BaseParseFrame.baseParseFrameInit' to initialise it.
baseParseFrameNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Buffer.Buffer
    -- ^ /@buffer@/: a t'GI.Gst.Structs.Buffer.Buffer'
    -> [GstBase.Flags.BaseParseFrameFlags]
    -- ^ /@flags@/: the flags
    -> Int32
    -- ^ /@overhead@/: number of bytes in this frame which should be counted as
    --     metadata overhead, ie. not used to calculate the average bitrate.
    --     Set to -1 to mark the entire frame as metadata. If in doubt, set to 0.
    -> m BaseParseFrame
    -- ^ __Returns:__ a newly-allocated t'GI.GstBase.Structs.BaseParseFrame.BaseParseFrame'. Free with
    --     'GI.GstBase.Structs.BaseParseFrame.baseParseFrameFree' when no longer needed.
baseParseFrameNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Buffer -> [BaseParseFrameFlags] -> Int32 -> m BaseParseFrame
baseParseFrameNew Buffer
buffer [BaseParseFrameFlags]
flags Int32
overhead = IO BaseParseFrame -> m BaseParseFrame
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BaseParseFrame -> m BaseParseFrame)
-> IO BaseParseFrame -> m BaseParseFrame
forall a b. (a -> b) -> a -> b
$ do
    Ptr Buffer
buffer' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
buffer
    let flags' :: CUInt
flags' = [BaseParseFrameFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [BaseParseFrameFlags]
flags
    Ptr BaseParseFrame
result <- Ptr Buffer -> CUInt -> Int32 -> IO (Ptr BaseParseFrame)
gst_base_parse_frame_new Ptr Buffer
buffer' CUInt
flags' Int32
overhead
    Text -> Ptr BaseParseFrame -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"baseParseFrameNew" Ptr BaseParseFrame
result
    BaseParseFrame
result' <- ((ManagedPtr BaseParseFrame -> BaseParseFrame)
-> Ptr BaseParseFrame -> IO BaseParseFrame
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseParseFrame -> BaseParseFrame
BaseParseFrame) Ptr BaseParseFrame
result
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    BaseParseFrame -> IO BaseParseFrame
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseParseFrame
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "gst_base_parse_frame_copy" gst_base_parse_frame_copy :: 
    Ptr BaseParseFrame ->                   -- frame : TInterface (Name {namespace = "GstBase", name = "BaseParseFrame"})
    IO (Ptr BaseParseFrame)

-- | Copies a t'GI.GstBase.Structs.BaseParseFrame.BaseParseFrame'.
-- 
-- /Since: 1.12.1/
baseParseFrameCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BaseParseFrame
    -- ^ /@frame@/: a t'GI.GstBase.Structs.BaseParseFrame.BaseParseFrame'
    -> m BaseParseFrame
    -- ^ __Returns:__ A copy of /@frame@/
baseParseFrameCopy :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseParseFrame -> m BaseParseFrame
baseParseFrameCopy BaseParseFrame
frame = IO BaseParseFrame -> m BaseParseFrame
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BaseParseFrame -> m BaseParseFrame)
-> IO BaseParseFrame -> m BaseParseFrame
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseParseFrame
frame' <- BaseParseFrame -> IO (Ptr BaseParseFrame)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseParseFrame
frame
    Ptr BaseParseFrame
result <- Ptr BaseParseFrame -> IO (Ptr BaseParseFrame)
gst_base_parse_frame_copy Ptr BaseParseFrame
frame'
    Text -> Ptr BaseParseFrame -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"baseParseFrameCopy" Ptr BaseParseFrame
result
    BaseParseFrame
result' <- ((ManagedPtr BaseParseFrame -> BaseParseFrame)
-> Ptr BaseParseFrame -> IO BaseParseFrame
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseParseFrame -> BaseParseFrame
BaseParseFrame) Ptr BaseParseFrame
result
    BaseParseFrame -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseParseFrame
frame
    BaseParseFrame -> IO BaseParseFrame
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseParseFrame
result'

#if defined(ENABLE_OVERLOADING)
data BaseParseFrameCopyMethodInfo
instance (signature ~ (m BaseParseFrame), MonadIO m) => O.OverloadedMethod BaseParseFrameCopyMethodInfo BaseParseFrame signature where
    overloadedMethod = baseParseFrameCopy

instance O.OverloadedMethodInfo BaseParseFrameCopyMethodInfo BaseParseFrame where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstBase.Structs.BaseParseFrame.baseParseFrameCopy",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstbase-1.0.26/docs/GI-GstBase-Structs-BaseParseFrame.html#v:baseParseFrameCopy"
        })


#endif

-- method BaseParseFrame::free
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "frame"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BaseParseFrame" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GstBaseParseFrame"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_base_parse_frame_free" gst_base_parse_frame_free :: 
    Ptr BaseParseFrame ->                   -- frame : TInterface (Name {namespace = "GstBase", name = "BaseParseFrame"})
    IO ()

-- | Frees the provided /@frame@/.
baseParseFrameFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BaseParseFrame
    -- ^ /@frame@/: A t'GI.GstBase.Structs.BaseParseFrame.BaseParseFrame'
    -> m ()
baseParseFrameFree :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseParseFrame -> m ()
baseParseFrameFree BaseParseFrame
frame = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseParseFrame
frame' <- BaseParseFrame -> IO (Ptr BaseParseFrame)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseParseFrame
frame
    Ptr BaseParseFrame -> IO ()
gst_base_parse_frame_free Ptr BaseParseFrame
frame'
    BaseParseFrame -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseParseFrame
frame
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BaseParseFrameFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod BaseParseFrameFreeMethodInfo BaseParseFrame signature where
    overloadedMethod = baseParseFrameFree

instance O.OverloadedMethodInfo BaseParseFrameFreeMethodInfo BaseParseFrame where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstBase.Structs.BaseParseFrame.baseParseFrameFree",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstbase-1.0.26/docs/GI-GstBase-Structs-BaseParseFrame.html#v:baseParseFrameFree"
        })


#endif

-- method BaseParseFrame::init
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "frame"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BaseParseFrame" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GstBaseParseFrame."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_base_parse_frame_init" gst_base_parse_frame_init :: 
    Ptr BaseParseFrame ->                   -- frame : TInterface (Name {namespace = "GstBase", name = "BaseParseFrame"})
    IO ()

-- | Sets a t'GI.GstBase.Structs.BaseParseFrame.BaseParseFrame' to initial state.  Currently this means
-- all public fields are zero-ed and a private flag is set to make
-- sure 'GI.GstBase.Structs.BaseParseFrame.baseParseFrameFree' only frees the contents but not
-- the actual frame. Use this function to initialise a t'GI.GstBase.Structs.BaseParseFrame.BaseParseFrame'
-- allocated on the stack.
baseParseFrameInit ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BaseParseFrame
    -- ^ /@frame@/: t'GI.GstBase.Structs.BaseParseFrame.BaseParseFrame'.
    -> m ()
baseParseFrameInit :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseParseFrame -> m ()
baseParseFrameInit BaseParseFrame
frame = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseParseFrame
frame' <- BaseParseFrame -> IO (Ptr BaseParseFrame)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseParseFrame
frame
    Ptr BaseParseFrame -> IO ()
gst_base_parse_frame_init Ptr BaseParseFrame
frame'
    BaseParseFrame -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseParseFrame
frame
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BaseParseFrameInitMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod BaseParseFrameInitMethodInfo BaseParseFrame signature where
    overloadedMethod = baseParseFrameInit

instance O.OverloadedMethodInfo BaseParseFrameInitMethodInfo BaseParseFrame where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstBase.Structs.BaseParseFrame.baseParseFrameInit",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstbase-1.0.26/docs/GI-GstBase-Structs-BaseParseFrame.html#v:baseParseFrameInit"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveBaseParseFrameMethod (t :: Symbol) (o :: *) :: * where
    ResolveBaseParseFrameMethod "copy" o = BaseParseFrameCopyMethodInfo
    ResolveBaseParseFrameMethod "free" o = BaseParseFrameFreeMethodInfo
    ResolveBaseParseFrameMethod "init" o = BaseParseFrameInitMethodInfo
    ResolveBaseParseFrameMethod l o = O.MethodResolutionFailed l o

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

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveBaseParseFrameMethod t BaseParseFrame, O.OverloadedMethod info BaseParseFrame p, R.HasField t BaseParseFrame p) => R.HasField t BaseParseFrame p where
    getField = O.overloadedMethod @info

#endif

instance (info ~ ResolveBaseParseFrameMethod t BaseParseFrame, O.OverloadedMethodInfo info BaseParseFrame) => OL.IsLabel t (O.MethodProxy info BaseParseFrame) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif

#endif