{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Buffers are the basic unit of data transfer in GStreamer. They contain the
-- timing and offset along with other arbitrary metadata that is associated
-- with the t'GI.Gst.Structs.Memory.Memory' blocks that the buffer contains.
-- 
-- Buffers are usually created with 'GI.Gst.Structs.Buffer.bufferNew'. After a buffer has been
-- created one will typically allocate memory for it and add it to the buffer.
-- The following example creates a buffer that can hold a given video frame
-- with a given width, height and bits per plane.
-- 
-- 
-- === /C code/
-- >  GstBuffer *buffer;
-- >  GstMemory *memory;
-- >  gint size, width, height, bpp;
-- >  ...
-- >  size = width * height * bpp;
-- >  buffer = gst_buffer_new ();
-- >  memory = gst_allocator_alloc (NULL, size, NULL);
-- >  gst_buffer_insert_memory (buffer, -1, memory);
-- >  ...
-- 
-- 
-- Alternatively, use 'GI.Gst.Structs.Buffer.bufferNewAllocate' to create a buffer with
-- preallocated data of a given size.
-- 
-- Buffers can contain a list of t'GI.Gst.Structs.Memory.Memory' objects. You can retrieve how many
-- memory objects with 'GI.Gst.Structs.Buffer.bufferNMemory' and you can get a pointer
-- to memory with 'GI.Gst.Structs.Buffer.bufferPeekMemory'
-- 
-- A buffer will usually have timestamps, and a duration, but neither of these
-- are guaranteed (they may be set to 'GI.Gst.Constants.CLOCK_TIME_NONE'). Whenever a
-- meaningful value can be given for these, they should be set. The timestamps
-- and duration are measured in nanoseconds (they are @/GstClockTime/@ values).
-- 
-- The buffer DTS refers to the timestamp when the buffer should be decoded and
-- is usually monotonically increasing. The buffer PTS refers to the timestamp when
-- the buffer content should be presented to the user and is not always
-- monotonically increasing.
-- 
-- A buffer can also have one or both of a start and an end offset. These are
-- media-type specific. For video buffers, the start offset will generally be
-- the frame number. For audio buffers, it will be the number of samples
-- produced so far. For compressed data, it could be the byte offset in a
-- source or destination file. Likewise, the end offset will be the offset of
-- the end of the buffer. These can only be meaningfully interpreted if you
-- know the media type of the buffer (the preceding CAPS event). Either or both
-- can be set to 'GI.Gst.Constants.BUFFER_OFFSET_NONE'.
-- 
-- @/gst_buffer_ref()/@ is used to increase the refcount of a buffer. This must be
-- done when you want to keep a handle to the buffer after pushing it to the
-- next element. The buffer refcount determines the writability of the buffer, a
-- buffer is only writable when the refcount is exactly 1, i.e. when the caller
-- has the only reference to the buffer.
-- 
-- To efficiently create a smaller buffer out of an existing one, you can
-- use 'GI.Gst.Structs.Buffer.bufferCopyRegion'. This method tries to share the memory objects
-- between the two buffers.
-- 
-- If a plug-in wants to modify the buffer data or metadata in-place, it should
-- first obtain a buffer that is safe to modify by using
-- @/gst_buffer_make_writable()/@. This function is optimized so that a copy will
-- only be made when it is necessary.
-- 
-- Several flags of the buffer can be set and unset with the
-- @/GST_BUFFER_FLAG_SET()/@ and @/GST_BUFFER_FLAG_UNSET()/@ macros. Use
-- @/GST_BUFFER_FLAG_IS_SET()/@ to test if a certain t'GI.Gst.Flags.BufferFlags' flag is set.
-- 
-- Buffers can be efficiently merged into a larger buffer with
-- 'GI.Gst.Structs.Buffer.bufferAppend'. Copying of memory will only be done when absolutely
-- needed.
-- 
-- Arbitrary extra metadata can be set on a buffer with 'GI.Gst.Structs.Buffer.bufferAddMeta'.
-- Metadata can be retrieved with 'GI.Gst.Structs.Buffer.bufferGetMeta'. See also t'GI.Gst.Structs.Meta.Meta'.
-- 
-- An element should either unref the buffer or push it out on a src pad
-- using 'GI.Gst.Objects.Pad.padPush' (see t'GI.Gst.Objects.Pad.Pad').
-- 
-- Buffers are usually freed by unreffing them with @/gst_buffer_unref()/@. When
-- the refcount drops to 0, any memory and metadata pointed to by the buffer is
-- unreffed as well. Buffers allocated from a t'GI.Gst.Objects.BufferPool.BufferPool' will be returned to
-- the pool when the refcount drops to 0.
-- 
-- The t'GI.Gst.Structs.ParentBufferMeta.ParentBufferMeta' is a meta which can be attached to a t'GI.Gst.Structs.Buffer.Buffer'
-- to hold a reference to another buffer that is only released when the child
-- t'GI.Gst.Structs.Buffer.Buffer' is released.
-- 
-- Typically, t'GI.Gst.Structs.ParentBufferMeta.ParentBufferMeta' is used when the child buffer is directly
-- using the t'GI.Gst.Structs.Memory.Memory' of the parent buffer, and wants to prevent the parent
-- buffer from being returned to a buffer pool until the t'GI.Gst.Structs.Memory.Memory' is available
-- for re-use. (Since: 1.6)

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

module GI.Gst.Structs.Buffer
    ( 

-- * Exported types
    Buffer(..)                              ,
    newZeroBuffer                           ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [addCustomMeta]("GI.Gst.Structs.Buffer#g:method:addCustomMeta"), [addMeta]("GI.Gst.Structs.Buffer#g:method:addMeta"), [addParentBufferMeta]("GI.Gst.Structs.Buffer#g:method:addParentBufferMeta"), [addProtectionMeta]("GI.Gst.Structs.Buffer#g:method:addProtectionMeta"), [addReferenceTimestampMeta]("GI.Gst.Structs.Buffer#g:method:addReferenceTimestampMeta"), [append]("GI.Gst.Structs.Buffer#g:method:append"), [appendMemory]("GI.Gst.Structs.Buffer#g:method:appendMemory"), [appendRegion]("GI.Gst.Structs.Buffer#g:method:appendRegion"), [copyDeep]("GI.Gst.Structs.Buffer#g:method:copyDeep"), [copyInto]("GI.Gst.Structs.Buffer#g:method:copyInto"), [copyRegion]("GI.Gst.Structs.Buffer#g:method:copyRegion"), [extract]("GI.Gst.Structs.Buffer#g:method:extract"), [extractDup]("GI.Gst.Structs.Buffer#g:method:extractDup"), [fill]("GI.Gst.Structs.Buffer#g:method:fill"), [findMemory]("GI.Gst.Structs.Buffer#g:method:findMemory"), [foreachMeta]("GI.Gst.Structs.Buffer#g:method:foreachMeta"), [hasFlags]("GI.Gst.Structs.Buffer#g:method:hasFlags"), [insertMemory]("GI.Gst.Structs.Buffer#g:method:insertMemory"), [isAllMemoryWritable]("GI.Gst.Structs.Buffer#g:method:isAllMemoryWritable"), [isMemoryRangeWritable]("GI.Gst.Structs.Buffer#g:method:isMemoryRangeWritable"), [map]("GI.Gst.Structs.Buffer#g:method:map"), [mapRange]("GI.Gst.Structs.Buffer#g:method:mapRange"), [memcmp]("GI.Gst.Structs.Buffer#g:method:memcmp"), [memset]("GI.Gst.Structs.Buffer#g:method:memset"), [nMemory]("GI.Gst.Structs.Buffer#g:method:nMemory"), [peekMemory]("GI.Gst.Structs.Buffer#g:method:peekMemory"), [prependMemory]("GI.Gst.Structs.Buffer#g:method:prependMemory"), [removeAllMemory]("GI.Gst.Structs.Buffer#g:method:removeAllMemory"), [removeMemory]("GI.Gst.Structs.Buffer#g:method:removeMemory"), [removeMemoryRange]("GI.Gst.Structs.Buffer#g:method:removeMemoryRange"), [removeMeta]("GI.Gst.Structs.Buffer#g:method:removeMeta"), [replaceAllMemory]("GI.Gst.Structs.Buffer#g:method:replaceAllMemory"), [replaceMemory]("GI.Gst.Structs.Buffer#g:method:replaceMemory"), [replaceMemoryRange]("GI.Gst.Structs.Buffer#g:method:replaceMemoryRange"), [resize]("GI.Gst.Structs.Buffer#g:method:resize"), [resizeRange]("GI.Gst.Structs.Buffer#g:method:resizeRange"), [unmap]("GI.Gst.Structs.Buffer#g:method:unmap"), [unsetFlags]("GI.Gst.Structs.Buffer#g:method:unsetFlags").
-- 
-- ==== Getters
-- [getAllMemory]("GI.Gst.Structs.Buffer#g:method:getAllMemory"), [getCustomMeta]("GI.Gst.Structs.Buffer#g:method:getCustomMeta"), [getFlags]("GI.Gst.Structs.Buffer#g:method:getFlags"), [getMemory]("GI.Gst.Structs.Buffer#g:method:getMemory"), [getMemoryRange]("GI.Gst.Structs.Buffer#g:method:getMemoryRange"), [getMeta]("GI.Gst.Structs.Buffer#g:method:getMeta"), [getNMeta]("GI.Gst.Structs.Buffer#g:method:getNMeta"), [getReferenceTimestampMeta]("GI.Gst.Structs.Buffer#g:method:getReferenceTimestampMeta"), [getSize]("GI.Gst.Structs.Buffer#g:method:getSize"), [getSizes]("GI.Gst.Structs.Buffer#g:method:getSizes"), [getSizesRange]("GI.Gst.Structs.Buffer#g:method:getSizesRange").
-- 
-- ==== Setters
-- [setFlags]("GI.Gst.Structs.Buffer#g:method:setFlags"), [setSize]("GI.Gst.Structs.Buffer#g:method:setSize").

#if defined(ENABLE_OVERLOADING)
    ResolveBufferMethod                     ,
#endif

-- ** addCustomMeta #method:addCustomMeta#

#if defined(ENABLE_OVERLOADING)
    BufferAddCustomMetaMethodInfo           ,
#endif
    bufferAddCustomMeta                     ,


-- ** addMeta #method:addMeta#

#if defined(ENABLE_OVERLOADING)
    BufferAddMetaMethodInfo                 ,
#endif
    bufferAddMeta                           ,


-- ** addParentBufferMeta #method:addParentBufferMeta#

#if defined(ENABLE_OVERLOADING)
    BufferAddParentBufferMetaMethodInfo     ,
#endif
    bufferAddParentBufferMeta               ,


-- ** addProtectionMeta #method:addProtectionMeta#

#if defined(ENABLE_OVERLOADING)
    BufferAddProtectionMetaMethodInfo       ,
#endif
    bufferAddProtectionMeta                 ,


-- ** addReferenceTimestampMeta #method:addReferenceTimestampMeta#

#if defined(ENABLE_OVERLOADING)
    BufferAddReferenceTimestampMetaMethodInfo,
#endif
    bufferAddReferenceTimestampMeta         ,


-- ** append #method:append#

#if defined(ENABLE_OVERLOADING)
    BufferAppendMethodInfo                  ,
#endif
    bufferAppend                            ,


-- ** appendMemory #method:appendMemory#

#if defined(ENABLE_OVERLOADING)
    BufferAppendMemoryMethodInfo            ,
#endif
    bufferAppendMemory                      ,


-- ** appendRegion #method:appendRegion#

#if defined(ENABLE_OVERLOADING)
    BufferAppendRegionMethodInfo            ,
#endif
    bufferAppendRegion                      ,


-- ** copyDeep #method:copyDeep#

#if defined(ENABLE_OVERLOADING)
    BufferCopyDeepMethodInfo                ,
#endif
    bufferCopyDeep                          ,


-- ** copyInto #method:copyInto#

#if defined(ENABLE_OVERLOADING)
    BufferCopyIntoMethodInfo                ,
#endif
    bufferCopyInto                          ,


-- ** copyRegion #method:copyRegion#

#if defined(ENABLE_OVERLOADING)
    BufferCopyRegionMethodInfo              ,
#endif
    bufferCopyRegion                        ,


-- ** extract #method:extract#

#if defined(ENABLE_OVERLOADING)
    BufferExtractMethodInfo                 ,
#endif
    bufferExtract                           ,


-- ** extractDup #method:extractDup#

#if defined(ENABLE_OVERLOADING)
    BufferExtractDupMethodInfo              ,
#endif
    bufferExtractDup                        ,


-- ** fill #method:fill#

#if defined(ENABLE_OVERLOADING)
    BufferFillMethodInfo                    ,
#endif
    bufferFill                              ,


-- ** findMemory #method:findMemory#

#if defined(ENABLE_OVERLOADING)
    BufferFindMemoryMethodInfo              ,
#endif
    bufferFindMemory                        ,


-- ** foreachMeta #method:foreachMeta#

#if defined(ENABLE_OVERLOADING)
    BufferForeachMetaMethodInfo             ,
#endif
    bufferForeachMeta                       ,


-- ** getAllMemory #method:getAllMemory#

#if defined(ENABLE_OVERLOADING)
    BufferGetAllMemoryMethodInfo            ,
#endif
    bufferGetAllMemory                      ,


-- ** getCustomMeta #method:getCustomMeta#

#if defined(ENABLE_OVERLOADING)
    BufferGetCustomMetaMethodInfo           ,
#endif
    bufferGetCustomMeta                     ,


-- ** getFlags #method:getFlags#

#if defined(ENABLE_OVERLOADING)
    BufferGetFlagsMethodInfo                ,
#endif
    bufferGetFlags                          ,


-- ** getMaxMemory #method:getMaxMemory#

    bufferGetMaxMemory                      ,


-- ** getMemory #method:getMemory#

#if defined(ENABLE_OVERLOADING)
    BufferGetMemoryMethodInfo               ,
#endif
    bufferGetMemory                         ,


-- ** getMemoryRange #method:getMemoryRange#

#if defined(ENABLE_OVERLOADING)
    BufferGetMemoryRangeMethodInfo          ,
#endif
    bufferGetMemoryRange                    ,


-- ** getMeta #method:getMeta#

#if defined(ENABLE_OVERLOADING)
    BufferGetMetaMethodInfo                 ,
#endif
    bufferGetMeta                           ,


-- ** getNMeta #method:getNMeta#

#if defined(ENABLE_OVERLOADING)
    BufferGetNMetaMethodInfo                ,
#endif
    bufferGetNMeta                          ,


-- ** getReferenceTimestampMeta #method:getReferenceTimestampMeta#

#if defined(ENABLE_OVERLOADING)
    BufferGetReferenceTimestampMetaMethodInfo,
#endif
    bufferGetReferenceTimestampMeta         ,


-- ** getSize #method:getSize#

#if defined(ENABLE_OVERLOADING)
    BufferGetSizeMethodInfo                 ,
#endif
    bufferGetSize                           ,


-- ** getSizes #method:getSizes#

#if defined(ENABLE_OVERLOADING)
    BufferGetSizesMethodInfo                ,
#endif
    bufferGetSizes                          ,


-- ** getSizesRange #method:getSizesRange#

#if defined(ENABLE_OVERLOADING)
    BufferGetSizesRangeMethodInfo           ,
#endif
    bufferGetSizesRange                     ,


-- ** hasFlags #method:hasFlags#

#if defined(ENABLE_OVERLOADING)
    BufferHasFlagsMethodInfo                ,
#endif
    bufferHasFlags                          ,


-- ** insertMemory #method:insertMemory#

#if defined(ENABLE_OVERLOADING)
    BufferInsertMemoryMethodInfo            ,
#endif
    bufferInsertMemory                      ,


-- ** isAllMemoryWritable #method:isAllMemoryWritable#

#if defined(ENABLE_OVERLOADING)
    BufferIsAllMemoryWritableMethodInfo     ,
#endif
    bufferIsAllMemoryWritable               ,


-- ** isMemoryRangeWritable #method:isMemoryRangeWritable#

#if defined(ENABLE_OVERLOADING)
    BufferIsMemoryRangeWritableMethodInfo   ,
#endif
    bufferIsMemoryRangeWritable             ,


-- ** map #method:map#

#if defined(ENABLE_OVERLOADING)
    BufferMapMethodInfo                     ,
#endif
    bufferMap                               ,


-- ** mapRange #method:mapRange#

#if defined(ENABLE_OVERLOADING)
    BufferMapRangeMethodInfo                ,
#endif
    bufferMapRange                          ,


-- ** memcmp #method:memcmp#

#if defined(ENABLE_OVERLOADING)
    BufferMemcmpMethodInfo                  ,
#endif
    bufferMemcmp                            ,


-- ** memset #method:memset#

#if defined(ENABLE_OVERLOADING)
    BufferMemsetMethodInfo                  ,
#endif
    bufferMemset                            ,


-- ** nMemory #method:nMemory#

#if defined(ENABLE_OVERLOADING)
    BufferNMemoryMethodInfo                 ,
#endif
    bufferNMemory                           ,


-- ** new #method:new#

    bufferNew                               ,


-- ** newAllocate #method:newAllocate#

    bufferNewAllocate                       ,


-- ** newMemdup #method:newMemdup#

    bufferNewMemdup                         ,


-- ** newWrapped #method:newWrapped#

    bufferNewWrapped                        ,


-- ** newWrappedBytes #method:newWrappedBytes#

    bufferNewWrappedBytes                   ,


-- ** newWrappedFull #method:newWrappedFull#

    bufferNewWrappedFull                    ,


-- ** peekMemory #method:peekMemory#

#if defined(ENABLE_OVERLOADING)
    BufferPeekMemoryMethodInfo              ,
#endif
    bufferPeekMemory                        ,


-- ** prependMemory #method:prependMemory#

#if defined(ENABLE_OVERLOADING)
    BufferPrependMemoryMethodInfo           ,
#endif
    bufferPrependMemory                     ,


-- ** removeAllMemory #method:removeAllMemory#

#if defined(ENABLE_OVERLOADING)
    BufferRemoveAllMemoryMethodInfo         ,
#endif
    bufferRemoveAllMemory                   ,


-- ** removeMemory #method:removeMemory#

#if defined(ENABLE_OVERLOADING)
    BufferRemoveMemoryMethodInfo            ,
#endif
    bufferRemoveMemory                      ,


-- ** removeMemoryRange #method:removeMemoryRange#

#if defined(ENABLE_OVERLOADING)
    BufferRemoveMemoryRangeMethodInfo       ,
#endif
    bufferRemoveMemoryRange                 ,


-- ** removeMeta #method:removeMeta#

#if defined(ENABLE_OVERLOADING)
    BufferRemoveMetaMethodInfo              ,
#endif
    bufferRemoveMeta                        ,


-- ** replaceAllMemory #method:replaceAllMemory#

#if defined(ENABLE_OVERLOADING)
    BufferReplaceAllMemoryMethodInfo        ,
#endif
    bufferReplaceAllMemory                  ,


-- ** replaceMemory #method:replaceMemory#

#if defined(ENABLE_OVERLOADING)
    BufferReplaceMemoryMethodInfo           ,
#endif
    bufferReplaceMemory                     ,


-- ** replaceMemoryRange #method:replaceMemoryRange#

#if defined(ENABLE_OVERLOADING)
    BufferReplaceMemoryRangeMethodInfo      ,
#endif
    bufferReplaceMemoryRange                ,


-- ** resize #method:resize#

#if defined(ENABLE_OVERLOADING)
    BufferResizeMethodInfo                  ,
#endif
    bufferResize                            ,


-- ** resizeRange #method:resizeRange#

#if defined(ENABLE_OVERLOADING)
    BufferResizeRangeMethodInfo             ,
#endif
    bufferResizeRange                       ,


-- ** setFlags #method:setFlags#

#if defined(ENABLE_OVERLOADING)
    BufferSetFlagsMethodInfo                ,
#endif
    bufferSetFlags                          ,


-- ** setSize #method:setSize#

#if defined(ENABLE_OVERLOADING)
    BufferSetSizeMethodInfo                 ,
#endif
    bufferSetSize                           ,


-- ** unmap #method:unmap#

#if defined(ENABLE_OVERLOADING)
    BufferUnmapMethodInfo                   ,
#endif
    bufferUnmap                             ,


-- ** unsetFlags #method:unsetFlags#

#if defined(ENABLE_OVERLOADING)
    BufferUnsetFlagsMethodInfo              ,
#endif
    bufferUnsetFlags                        ,




 -- * Properties


-- ** dts #attr:dts#
-- | decoding timestamp of the buffer, can be 'GI.Gst.Constants.CLOCK_TIME_NONE' when the
--     dts is not known or relevant. The dts contains the timestamp when the
--     media should be processed.

#if defined(ENABLE_OVERLOADING)
    buffer_dts                              ,
#endif
    getBufferDts                            ,
    setBufferDts                            ,


-- ** duration #attr:duration#
-- | duration in time of the buffer data, can be 'GI.Gst.Constants.CLOCK_TIME_NONE'
--     when the duration is not known or relevant.

#if defined(ENABLE_OVERLOADING)
    buffer_duration                         ,
#endif
    getBufferDuration                       ,
    setBufferDuration                       ,


-- ** miniObject #attr:miniObject#
-- | the parent structure

#if defined(ENABLE_OVERLOADING)
    buffer_miniObject                       ,
#endif
    getBufferMiniObject                     ,


-- ** offset #attr:offset#
-- | a media specific offset for the buffer data.
--     For video frames, this is the frame number of this buffer.
--     For audio samples, this is the offset of the first sample in this buffer.
--     For file data or compressed data this is the byte offset of the first
--       byte in this buffer.

#if defined(ENABLE_OVERLOADING)
    buffer_offset                           ,
#endif
    getBufferOffset                         ,
    setBufferOffset                         ,


-- ** offsetEnd #attr:offsetEnd#
-- | the last offset contained in this buffer. It has the same
--     format as /@offset@/.

#if defined(ENABLE_OVERLOADING)
    buffer_offsetEnd                        ,
#endif
    getBufferOffsetEnd                      ,
    setBufferOffsetEnd                      ,


-- ** pool #attr:pool#
-- | pointer to the pool owner of the buffer

#if defined(ENABLE_OVERLOADING)
    buffer_pool                             ,
#endif
    clearBufferPool                         ,
    getBufferPool                           ,
    setBufferPool                           ,


-- ** pts #attr:pts#
-- | presentation timestamp of the buffer, can be 'GI.Gst.Constants.CLOCK_TIME_NONE' when the
--     pts is not known or relevant. The pts contains the timestamp when the
--     media should be presented to the user.

#if defined(ENABLE_OVERLOADING)
    buffer_pts                              ,
#endif
    getBufferPts                            ,
    setBufferPts                            ,




    ) 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.GLib.Callbacks as GLib.Callbacks
import qualified GI.GLib.Structs.Bytes as GLib.Bytes
import qualified GI.Gst.Callbacks as Gst.Callbacks
import {-# SOURCE #-} qualified GI.Gst.Flags as Gst.Flags
import {-# SOURCE #-} qualified GI.Gst.Objects.Allocator as Gst.Allocator
import {-# SOURCE #-} qualified GI.Gst.Objects.BufferPool as Gst.BufferPool
import {-# SOURCE #-} qualified GI.Gst.Structs.AllocationParams as Gst.AllocationParams
import {-# SOURCE #-} qualified GI.Gst.Structs.Caps as Gst.Caps
import {-# SOURCE #-} qualified GI.Gst.Structs.CustomMeta as Gst.CustomMeta
import {-# SOURCE #-} qualified GI.Gst.Structs.MapInfo as Gst.MapInfo
import {-# SOURCE #-} qualified GI.Gst.Structs.Memory as Gst.Memory
import {-# SOURCE #-} qualified GI.Gst.Structs.Meta as Gst.Meta
import {-# SOURCE #-} qualified GI.Gst.Structs.MetaInfo as Gst.MetaInfo
import {-# SOURCE #-} qualified GI.Gst.Structs.MiniObject as Gst.MiniObject
import {-# SOURCE #-} qualified GI.Gst.Structs.ParentBufferMeta as Gst.ParentBufferMeta
import {-# SOURCE #-} qualified GI.Gst.Structs.ProtectionMeta as Gst.ProtectionMeta
import {-# SOURCE #-} qualified GI.Gst.Structs.ReferenceTimestampMeta as Gst.ReferenceTimestampMeta
import {-# SOURCE #-} qualified GI.Gst.Structs.Structure as Gst.Structure

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

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

foreign import ccall "gst_buffer_get_type" c_gst_buffer_get_type :: 
    IO GType

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

instance B.Types.TypedObject Buffer where
    glibType :: IO GType
glibType = IO GType
c_gst_buffer_get_type

instance B.Types.GBoxed Buffer

-- | Convert 'Buffer' 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 Buffer) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gst_buffer_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Buffer -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Buffer
P.Nothing = Ptr GValue -> Ptr Buffer -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv (Ptr Buffer
forall a. Ptr a
FP.nullPtr :: FP.Ptr Buffer)
    gvalueSet_ Ptr GValue
gv (P.Just Buffer
obj) = Buffer -> (Ptr Buffer -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Buffer
obj (Ptr GValue -> Ptr Buffer -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Buffer)
gvalueGet_ Ptr GValue
gv = do
        Ptr Buffer
ptr <- Ptr GValue -> IO (Ptr Buffer)
forall b. Ptr GValue -> IO (Ptr b)
B.GValue.get_boxed Ptr GValue
gv :: IO (Ptr Buffer)
        if Ptr Buffer
ptr Ptr Buffer -> Ptr Buffer -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Buffer
forall a. Ptr a
FP.nullPtr
        then Buffer -> Maybe Buffer
forall a. a -> Maybe a
P.Just (Buffer -> Maybe Buffer) -> IO Buffer -> IO (Maybe Buffer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr Buffer -> Buffer) -> Ptr Buffer -> IO Buffer
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr Buffer -> Buffer
Buffer Ptr Buffer
ptr
        else Maybe Buffer -> IO (Maybe Buffer)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Buffer
forall a. Maybe a
P.Nothing
        
    

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

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


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

#if defined(ENABLE_OVERLOADING)
data BufferMiniObjectFieldInfo
instance AttrInfo BufferMiniObjectFieldInfo where
    type AttrBaseTypeConstraint BufferMiniObjectFieldInfo = (~) Buffer
    type AttrAllowedOps BufferMiniObjectFieldInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint BufferMiniObjectFieldInfo = (~) (Ptr Gst.MiniObject.MiniObject)
    type AttrTransferTypeConstraint BufferMiniObjectFieldInfo = (~)(Ptr Gst.MiniObject.MiniObject)
    type AttrTransferType BufferMiniObjectFieldInfo = (Ptr Gst.MiniObject.MiniObject)
    type AttrGetType BufferMiniObjectFieldInfo = Gst.MiniObject.MiniObject
    type AttrLabel BufferMiniObjectFieldInfo = "mini_object"
    type AttrOrigin BufferMiniObjectFieldInfo = Buffer
    attrGet = getBufferMiniObject
    attrSet = undefined
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Buffer.miniObject"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Buffer.html#g:attr:miniObject"
        })

buffer_miniObject :: AttrLabelProxy "miniObject"
buffer_miniObject = AttrLabelProxy

#endif


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

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

-- | Set the value of the “@pool@” 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' #pool
-- @
clearBufferPool :: MonadIO m => Buffer -> m ()
clearBufferPool :: forall (m :: * -> *). MonadIO m => Buffer -> m ()
clearBufferPool Buffer
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
$ Buffer -> (Ptr Buffer -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Buffer
s ((Ptr Buffer -> IO ()) -> IO ()) -> (Ptr Buffer -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Buffer
ptr -> do
    Ptr (Ptr BufferPool) -> Ptr BufferPool -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Buffer
ptr Ptr Buffer -> Int -> Ptr (Ptr BufferPool)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64) (Ptr BufferPool
forall a. Ptr a
FP.nullPtr :: Ptr Gst.BufferPool.BufferPool)

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

buffer_pool :: AttrLabelProxy "pool"
buffer_pool = AttrLabelProxy

#endif


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

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

buffer_pts :: AttrLabelProxy "pts"
buffer_pts = AttrLabelProxy

#endif


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

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

buffer_dts :: AttrLabelProxy "dts"
buffer_dts = AttrLabelProxy

#endif


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

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

buffer_duration :: AttrLabelProxy "duration"
buffer_duration = 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' buffer #offset
-- @
getBufferOffset :: MonadIO m => Buffer -> m Word64
getBufferOffset :: forall (m :: * -> *). MonadIO m => Buffer -> m Word64
getBufferOffset Buffer
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
$ Buffer -> (Ptr Buffer -> IO Word64) -> IO Word64
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Buffer
s ((Ptr Buffer -> IO Word64) -> IO Word64)
-> (Ptr Buffer -> IO Word64) -> IO Word64
forall a b. (a -> b) -> a -> b
$ \Ptr Buffer
ptr -> do
    Word64
val <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek (Ptr Buffer
ptr Ptr Buffer -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
96) :: 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' buffer [ #offset 'Data.GI.Base.Attributes.:=' value ]
-- @
setBufferOffset :: MonadIO m => Buffer -> Word64 -> m ()
setBufferOffset :: forall (m :: * -> *). MonadIO m => Buffer -> Word64 -> m ()
setBufferOffset Buffer
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
$ Buffer -> (Ptr Buffer -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Buffer
s ((Ptr Buffer -> IO ()) -> IO ()) -> (Ptr Buffer -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Buffer
ptr -> do
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Buffer
ptr Ptr Buffer -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
96) (Word64
val :: Word64)

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

buffer_offset :: AttrLabelProxy "offset"
buffer_offset = AttrLabelProxy

#endif


-- | Get the value of the “@offset_end@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' buffer #offsetEnd
-- @
getBufferOffsetEnd :: MonadIO m => Buffer -> m Word64
getBufferOffsetEnd :: forall (m :: * -> *). MonadIO m => Buffer -> m Word64
getBufferOffsetEnd Buffer
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
$ Buffer -> (Ptr Buffer -> IO Word64) -> IO Word64
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Buffer
s ((Ptr Buffer -> IO Word64) -> IO Word64)
-> (Ptr Buffer -> IO Word64) -> IO Word64
forall a b. (a -> b) -> a -> b
$ \Ptr Buffer
ptr -> do
    Word64
val <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek (Ptr Buffer
ptr Ptr Buffer -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
104) :: 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_end@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' buffer [ #offsetEnd 'Data.GI.Base.Attributes.:=' value ]
-- @
setBufferOffsetEnd :: MonadIO m => Buffer -> Word64 -> m ()
setBufferOffsetEnd :: forall (m :: * -> *). MonadIO m => Buffer -> Word64 -> m ()
setBufferOffsetEnd Buffer
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
$ Buffer -> (Ptr Buffer -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Buffer
s ((Ptr Buffer -> IO ()) -> IO ()) -> (Ptr Buffer -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Buffer
ptr -> do
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Buffer
ptr Ptr Buffer -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
104) (Word64
val :: Word64)

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

buffer_offsetEnd :: AttrLabelProxy "offsetEnd"
buffer_offsetEnd = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Buffer
type instance O.AttributeList Buffer = BufferAttributeList
type BufferAttributeList = ('[ '("miniObject", BufferMiniObjectFieldInfo), '("pool", BufferPoolFieldInfo), '("pts", BufferPtsFieldInfo), '("dts", BufferDtsFieldInfo), '("duration", BufferDurationFieldInfo), '("offset", BufferOffsetFieldInfo), '("offsetEnd", BufferOffsetEndFieldInfo)] :: [(Symbol, *)])
#endif

-- method Buffer::new
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Buffer" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_new" gst_buffer_new :: 
    IO (Ptr Buffer)

-- | Creates a newly allocated buffer without any data.
bufferNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Buffer
    -- ^ __Returns:__ the new t'GI.Gst.Structs.Buffer.Buffer'.
bufferNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Buffer
bufferNew  = IO Buffer -> m Buffer
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Buffer -> m Buffer) -> IO Buffer -> m Buffer
forall a b. (a -> b) -> a -> b
$ do
    Ptr Buffer
result <- IO (Ptr Buffer)
gst_buffer_new
    Text -> Ptr Buffer -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"bufferNew" Ptr Buffer
result
    Buffer
result' <- ((ManagedPtr Buffer -> Buffer) -> Ptr Buffer -> IO Buffer
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Buffer -> Buffer
Buffer) Ptr Buffer
result
    Buffer -> IO Buffer
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Buffer::new_allocate
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "allocator"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Allocator" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the #GstAllocator to use, or %NULL to use the\n    default allocator"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "size"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the size in bytes of the new buffer's data."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "params"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "AllocationParams" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "optional parameters"
--                 , 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_buffer_new_allocate" gst_buffer_new_allocate :: 
    Ptr Gst.Allocator.Allocator ->          -- allocator : TInterface (Name {namespace = "Gst", name = "Allocator"})
    Word64 ->                               -- size : TBasicType TUInt64
    Ptr Gst.AllocationParams.AllocationParams -> -- params : TInterface (Name {namespace = "Gst", name = "AllocationParams"})
    IO (Ptr Buffer)

-- | Tries to create a newly allocated buffer with data of the given size and
-- extra parameters from /@allocator@/. If the requested amount of memory can\'t be
-- allocated, 'P.Nothing' will be returned. The allocated buffer memory is not cleared.
-- 
-- When /@allocator@/ is 'P.Nothing', the default memory allocator will be used.
-- 
-- Note that when /@size@/ == 0, the buffer will not have memory associated with it.
bufferNewAllocate ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Allocator.IsAllocator a) =>
    Maybe (a)
    -- ^ /@allocator@/: the t'GI.Gst.Objects.Allocator.Allocator' to use, or 'P.Nothing' to use the
    --     default allocator
    -> Word64
    -- ^ /@size@/: the size in bytes of the new buffer\'s data.
    -> Maybe (Gst.AllocationParams.AllocationParams)
    -- ^ /@params@/: optional parameters
    -> m (Maybe Buffer)
    -- ^ __Returns:__ a new t'GI.Gst.Structs.Buffer.Buffer'
bufferNewAllocate :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAllocator a) =>
Maybe a -> Word64 -> Maybe AllocationParams -> m (Maybe Buffer)
bufferNewAllocate Maybe a
allocator Word64
size Maybe AllocationParams
params = 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
$ do
    Ptr Allocator
maybeAllocator <- case Maybe a
allocator of
        Maybe a
Nothing -> Ptr Allocator -> IO (Ptr Allocator)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Allocator
forall a. Ptr a
nullPtr
        Just a
jAllocator -> do
            Ptr Allocator
jAllocator' <- a -> IO (Ptr Allocator)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jAllocator
            Ptr Allocator -> IO (Ptr Allocator)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Allocator
jAllocator'
    Ptr AllocationParams
maybeParams <- case Maybe AllocationParams
params of
        Maybe AllocationParams
Nothing -> Ptr AllocationParams -> IO (Ptr AllocationParams)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr AllocationParams
forall a. Ptr a
nullPtr
        Just AllocationParams
jParams -> do
            Ptr AllocationParams
jParams' <- AllocationParams -> IO (Ptr AllocationParams)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AllocationParams
jParams
            Ptr AllocationParams -> IO (Ptr AllocationParams)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr AllocationParams
jParams'
    Ptr Buffer
result <- Ptr Allocator -> Word64 -> Ptr AllocationParams -> IO (Ptr Buffer)
gst_buffer_new_allocate Ptr Allocator
maybeAllocator Word64
size Ptr AllocationParams
maybeParams
    Maybe Buffer
maybeResult <- Ptr Buffer -> (Ptr Buffer -> IO Buffer) -> IO (Maybe Buffer)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Buffer
result ((Ptr Buffer -> IO Buffer) -> IO (Maybe Buffer))
-> (Ptr Buffer -> IO Buffer) -> IO (Maybe Buffer)
forall a b. (a -> b) -> a -> b
$ \Ptr Buffer
result' -> do
        Buffer
result'' <- ((ManagedPtr Buffer -> Buffer) -> Ptr Buffer -> IO Buffer
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Buffer -> Buffer
Buffer) Ptr Buffer
result'
        Buffer -> IO Buffer
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer
result''
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
allocator a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe AllocationParams -> (AllocationParams -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe AllocationParams
params AllocationParams -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe Buffer -> IO (Maybe Buffer)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Buffer
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

-- method Buffer::new_memdup
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "data"
--           , argType = TCArray False (-1) 1 (TBasicType TUInt8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to copy into new buffer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "size"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "size of @data in bytes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "size"
--              , argType = TBasicType TUInt64
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "size of @data in bytes"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Buffer" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_new_memdup" gst_buffer_new_memdup :: 
    Ptr Word8 ->                            -- data : TCArray False (-1) 1 (TBasicType TUInt8)
    Word64 ->                               -- size : TBasicType TUInt64
    IO (Ptr Buffer)

-- | Creates a new buffer of size /@size@/ and fills it with a copy of /@data@/.
-- 
-- /Since: 1.20/
bufferNewMemdup ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ByteString
    -- ^ /@data@/: data to copy into new buffer
    -> m Buffer
    -- ^ __Returns:__ a new t'GI.Gst.Structs.Buffer.Buffer'
bufferNewMemdup :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ByteString -> m Buffer
bufferNewMemdup ByteString
data_ = IO Buffer -> m Buffer
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Buffer -> m Buffer) -> IO Buffer -> m Buffer
forall a b. (a -> b) -> a -> b
$ do
    let size :: Word64
size = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
data_
    Ptr Word8
data_' <- ByteString -> IO (Ptr Word8)
packByteString ByteString
data_
    Ptr Buffer
result <- Ptr Word8 -> Word64 -> IO (Ptr Buffer)
gst_buffer_new_memdup Ptr Word8
data_' Word64
size
    Text -> Ptr Buffer -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"bufferNewMemdup" Ptr Buffer
result
    Buffer
result' <- ((ManagedPtr Buffer -> Buffer) -> Ptr Buffer -> IO Buffer
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Buffer -> Buffer
Buffer) Ptr Buffer
result
    Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
data_'
    Buffer -> IO Buffer
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Buffer::new_wrapped
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "data"
--           , argType = TCArray False (-1) 1 (TBasicType TUInt8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to wrap" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "size"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "allocated size of @data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "size"
--              , argType = TBasicType TUInt64
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "allocated size of @data"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Buffer" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_new_wrapped" gst_buffer_new_wrapped :: 
    Ptr Word8 ->                            -- data : TCArray False (-1) 1 (TBasicType TUInt8)
    Word64 ->                               -- size : TBasicType TUInt64
    IO (Ptr Buffer)

-- | Creates a new buffer that wraps the given /@data@/. The memory will be freed
-- with 'GI.GLib.Functions.free' and will be marked writable.
bufferNewWrapped ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ByteString
    -- ^ /@data@/: data to wrap
    -> m Buffer
    -- ^ __Returns:__ a new t'GI.Gst.Structs.Buffer.Buffer'
bufferNewWrapped :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ByteString -> m Buffer
bufferNewWrapped ByteString
data_ = IO Buffer -> m Buffer
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Buffer -> m Buffer) -> IO Buffer -> m Buffer
forall a b. (a -> b) -> a -> b
$ do
    let size :: Word64
size = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
data_
    Ptr Word8
data_' <- ByteString -> IO (Ptr Word8)
packByteString ByteString
data_
    Ptr Buffer
result <- Ptr Word8 -> Word64 -> IO (Ptr Buffer)
gst_buffer_new_wrapped Ptr Word8
data_' Word64
size
    Text -> Ptr Buffer -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"bufferNewWrapped" Ptr Buffer
result
    Buffer
result' <- ((ManagedPtr Buffer -> Buffer) -> Ptr Buffer -> IO Buffer
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Buffer -> Buffer
Buffer) Ptr Buffer
result
    Buffer -> IO Buffer
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Buffer::new_wrapped_bytes
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "bytes"
--           , argType = TInterface Name { namespace = "GLib" , name = "Bytes" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GBytes to wrap" , 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_buffer_new_wrapped_bytes" gst_buffer_new_wrapped_bytes :: 
    Ptr GLib.Bytes.Bytes ->                 -- bytes : TInterface (Name {namespace = "GLib", name = "Bytes"})
    IO (Ptr Buffer)

-- | Creates a new t'GI.Gst.Structs.Buffer.Buffer' that wraps the given /@bytes@/. The data inside
-- /@bytes@/ cannot be 'P.Nothing' and the resulting buffer will be marked as read only.
-- 
-- /Since: 1.16/
bufferNewWrappedBytes ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GLib.Bytes.Bytes
    -- ^ /@bytes@/: a t'GI.GLib.Structs.Bytes.Bytes' to wrap
    -> m Buffer
    -- ^ __Returns:__ a new t'GI.Gst.Structs.Buffer.Buffer' wrapping /@bytes@/
bufferNewWrappedBytes :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Bytes -> m Buffer
bufferNewWrappedBytes Bytes
bytes = IO Buffer -> m Buffer
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Buffer -> m Buffer) -> IO Buffer -> m Buffer
forall a b. (a -> b) -> a -> b
$ do
    Ptr Bytes
bytes' <- Bytes -> IO (Ptr Bytes)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Bytes
bytes
    Ptr Buffer
result <- Ptr Bytes -> IO (Ptr Buffer)
gst_buffer_new_wrapped_bytes Ptr Bytes
bytes'
    Text -> Ptr Buffer -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"bufferNewWrappedBytes" Ptr Buffer
result
    Buffer
result' <- ((ManagedPtr Buffer -> Buffer) -> Ptr Buffer -> IO Buffer
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Buffer -> Buffer
Buffer) Ptr Buffer
result
    Bytes -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Bytes
bytes
    Buffer -> IO Buffer
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Buffer::new_wrapped_full
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "MemoryFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GstMemoryFlags" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TCArray False (-1) 4 (TBasicType TUInt8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to wrap" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "maxsize"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "allocated size of @data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "offset"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "offset in @data" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "size"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "size of valid data" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user_data" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "notify"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "called with @user_data when the memory is freed"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 5
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "size"
--              , argType = TBasicType TUInt64
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "size of valid data" , sinceVersion = Nothing }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Buffer" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_new_wrapped_full" gst_buffer_new_wrapped_full :: 
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gst", name = "MemoryFlags"})
    Ptr Word8 ->                            -- data : TCArray False (-1) 4 (TBasicType TUInt8)
    Word64 ->                               -- maxsize : TBasicType TUInt64
    Word64 ->                               -- offset : TBasicType TUInt64
    Word64 ->                               -- size : TBasicType TUInt64
    Ptr () ->                               -- user_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- notify : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO (Ptr Buffer)

-- | Allocates a new buffer that wraps the given memory. /@data@/ must point to
-- /@maxsize@/ of memory, the wrapped buffer will have the region from /@offset@/ and
-- /@size@/ visible.
-- 
-- When the buffer is destroyed, /@notify@/ will be called with /@userData@/.
-- 
-- The prefix\/padding must be filled with 0 if /@flags@/ contains
-- @/GST_MEMORY_FLAG_ZERO_PREFIXED/@ and @/GST_MEMORY_FLAG_ZERO_PADDED/@ respectively.
bufferNewWrappedFull ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    [Gst.Flags.MemoryFlags]
    -- ^ /@flags@/: t'GI.Gst.Flags.MemoryFlags'
    -> ByteString
    -- ^ /@data@/: data to wrap
    -> Word64
    -- ^ /@maxsize@/: allocated size of /@data@/
    -> Word64
    -- ^ /@offset@/: offset in /@data@/
    -> Maybe (GLib.Callbacks.DestroyNotify)
    -- ^ /@notify@/: called with /@userData@/ when the memory is freed
    -> m Buffer
    -- ^ __Returns:__ a new t'GI.Gst.Structs.Buffer.Buffer'
bufferNewWrappedFull :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
[MemoryFlags]
-> ByteString
-> Word64
-> Word64
-> Maybe DestroyNotify
-> m Buffer
bufferNewWrappedFull [MemoryFlags]
flags ByteString
data_ Word64
maxsize Word64
offset Maybe DestroyNotify
notify = IO Buffer -> m Buffer
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Buffer -> m Buffer) -> IO Buffer -> m Buffer
forall a b. (a -> b) -> a -> b
$ do
    let size :: Word64
size = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
data_
    let flags' :: CUInt
flags' = [MemoryFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [MemoryFlags]
flags
    Ptr Word8
data_' <- ByteString -> IO (Ptr Word8)
packByteString ByteString
data_
    FunPtr DestroyNotify
maybeNotify <- case Maybe DestroyNotify
notify of
        Maybe DestroyNotify
Nothing -> FunPtr DestroyNotify -> IO (FunPtr DestroyNotify)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr DestroyNotify
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just DestroyNotify
jNotify -> do
            Ptr (FunPtr DestroyNotify)
ptrnotify <- IO (Ptr (FunPtr DestroyNotify))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr GLib.Callbacks.C_DestroyNotify))
            FunPtr DestroyNotify
jNotify' <- DestroyNotify -> IO (FunPtr DestroyNotify)
GLib.Callbacks.mk_DestroyNotify (Maybe (Ptr (FunPtr DestroyNotify))
-> DestroyNotify -> DestroyNotify
GLib.Callbacks.wrap_DestroyNotify (Ptr (FunPtr DestroyNotify) -> Maybe (Ptr (FunPtr DestroyNotify))
forall a. a -> Maybe a
Just Ptr (FunPtr DestroyNotify)
ptrnotify) DestroyNotify
jNotify)
            Ptr (FunPtr DestroyNotify) -> FunPtr DestroyNotify -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr DestroyNotify)
ptrnotify FunPtr DestroyNotify
jNotify'
            FunPtr DestroyNotify -> IO (FunPtr DestroyNotify)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr DestroyNotify
jNotify'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Buffer
result <- CUInt
-> Ptr Word8
-> Word64
-> Word64
-> Word64
-> Ptr ()
-> FunPtr DestroyNotify
-> IO (Ptr Buffer)
gst_buffer_new_wrapped_full CUInt
flags' Ptr Word8
data_' Word64
maxsize Word64
offset Word64
size Ptr ()
forall a. Ptr a
userData FunPtr DestroyNotify
maybeNotify
    Text -> Ptr Buffer -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"bufferNewWrappedFull" Ptr Buffer
result
    Buffer
result' <- ((ManagedPtr Buffer -> Buffer) -> Ptr Buffer -> IO Buffer
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Buffer -> Buffer
Buffer) Ptr Buffer
result
    Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
data_'
    Buffer -> IO Buffer
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Buffer::add_custom_meta
-- method type : OrdinaryMethod
-- 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 = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the registered name of the desired custom meta"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "CustomMeta" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_add_custom_meta" gst_buffer_add_custom_meta :: 
    Ptr Buffer ->                           -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    CString ->                              -- name : TBasicType TUTF8
    IO (Ptr Gst.CustomMeta.CustomMeta)

-- | Creates and adds a t'GI.Gst.Structs.CustomMeta.CustomMeta' for the desired /@name@/. /@name@/ must have
-- been successfully registered with 'GI.Gst.Functions.metaRegisterCustom'.
-- 
-- /Since: 1.20/
bufferAddCustomMeta ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@buffer@/: a t'GI.Gst.Structs.Buffer.Buffer'
    -> T.Text
    -- ^ /@name@/: the registered name of the desired custom meta
    -> m (Maybe Gst.CustomMeta.CustomMeta)
    -- ^ __Returns:__ The t'GI.Gst.Structs.CustomMeta.CustomMeta' that was added to the buffer
bufferAddCustomMeta :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Buffer -> Text -> m (Maybe CustomMeta)
bufferAddCustomMeta Buffer
buffer Text
name = IO (Maybe CustomMeta) -> m (Maybe CustomMeta)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe CustomMeta) -> m (Maybe CustomMeta))
-> IO (Maybe CustomMeta) -> m (Maybe CustomMeta)
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
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr CustomMeta
result <- Ptr Buffer -> CString -> IO (Ptr CustomMeta)
gst_buffer_add_custom_meta Ptr Buffer
buffer' CString
name'
    Maybe CustomMeta
maybeResult <- Ptr CustomMeta
-> (Ptr CustomMeta -> IO CustomMeta) -> IO (Maybe CustomMeta)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr CustomMeta
result ((Ptr CustomMeta -> IO CustomMeta) -> IO (Maybe CustomMeta))
-> (Ptr CustomMeta -> IO CustomMeta) -> IO (Maybe CustomMeta)
forall a b. (a -> b) -> a -> b
$ \Ptr CustomMeta
result' -> do
        CustomMeta
result'' <- ((ManagedPtr CustomMeta -> CustomMeta)
-> Ptr CustomMeta -> IO CustomMeta
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr CustomMeta -> CustomMeta
Gst.CustomMeta.CustomMeta) Ptr CustomMeta
result'
        CustomMeta -> IO CustomMeta
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CustomMeta
result''
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Maybe CustomMeta -> IO (Maybe CustomMeta)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe CustomMeta
maybeResult

#if defined(ENABLE_OVERLOADING)
data BufferAddCustomMetaMethodInfo
instance (signature ~ (T.Text -> m (Maybe Gst.CustomMeta.CustomMeta)), MonadIO m) => O.OverloadedMethod BufferAddCustomMetaMethodInfo Buffer signature where
    overloadedMethod = bufferAddCustomMeta

instance O.OverloadedMethodInfo BufferAddCustomMetaMethodInfo Buffer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Buffer.bufferAddCustomMeta",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Buffer.html#v:bufferAddCustomMeta"
        })


#endif

-- method Buffer::add_meta
-- method type : OrdinaryMethod
-- 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 = "info"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "MetaInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstMetaInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "params"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "params for @info" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Meta" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_add_meta" gst_buffer_add_meta :: 
    Ptr Buffer ->                           -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    Ptr Gst.MetaInfo.MetaInfo ->            -- info : TInterface (Name {namespace = "Gst", name = "MetaInfo"})
    Ptr () ->                               -- params : TBasicType TPtr
    IO (Ptr Gst.Meta.Meta)

-- | Adds metadata for /@info@/ to /@buffer@/ using the parameters in /@params@/.
bufferAddMeta ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@buffer@/: a t'GI.Gst.Structs.Buffer.Buffer'
    -> Gst.MetaInfo.MetaInfo
    -- ^ /@info@/: a t'GI.Gst.Structs.MetaInfo.MetaInfo'
    -> Ptr ()
    -- ^ /@params@/: params for /@info@/
    -> m (Maybe Gst.Meta.Meta)
    -- ^ __Returns:__ the metadata for the api in /@info@/ on /@buffer@/.
bufferAddMeta :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Buffer -> MetaInfo -> Ptr () -> m (Maybe Meta)
bufferAddMeta Buffer
buffer MetaInfo
info Ptr ()
params = IO (Maybe Meta) -> m (Maybe Meta)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Meta) -> m (Maybe Meta))
-> IO (Maybe Meta) -> m (Maybe Meta)
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
    Ptr MetaInfo
info' <- MetaInfo -> IO (Ptr MetaInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MetaInfo
info
    Ptr Meta
result <- Ptr Buffer -> Ptr MetaInfo -> Ptr () -> IO (Ptr Meta)
gst_buffer_add_meta Ptr Buffer
buffer' Ptr MetaInfo
info' Ptr ()
params
    Maybe Meta
maybeResult <- Ptr Meta -> (Ptr Meta -> IO Meta) -> IO (Maybe Meta)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Meta
result ((Ptr Meta -> IO Meta) -> IO (Maybe Meta))
-> (Ptr Meta -> IO Meta) -> IO (Maybe Meta)
forall a b. (a -> b) -> a -> b
$ \Ptr Meta
result' -> do
        Meta
result'' <- ((ManagedPtr Meta -> Meta) -> Ptr Meta -> IO Meta
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr Meta -> Meta
Gst.Meta.Meta) Ptr Meta
result'
        Meta -> IO Meta
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Meta
result''
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    MetaInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MetaInfo
info
    Maybe Meta -> IO (Maybe Meta)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Meta
maybeResult

#if defined(ENABLE_OVERLOADING)
data BufferAddMetaMethodInfo
instance (signature ~ (Gst.MetaInfo.MetaInfo -> Ptr () -> m (Maybe Gst.Meta.Meta)), MonadIO m) => O.OverloadedMethod BufferAddMetaMethodInfo Buffer signature where
    overloadedMethod = bufferAddMeta

instance O.OverloadedMethodInfo BufferAddMetaMethodInfo Buffer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Buffer.bufferAddMeta",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Buffer.html#v:bufferAddMeta"
        })


#endif

-- method Buffer::add_parent_buffer_meta
-- method type : OrdinaryMethod
-- 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 = "ref"
--           , argType = TInterface Name { namespace = "Gst" , name = "Buffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBuffer to ref"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gst" , name = "ParentBufferMeta" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_add_parent_buffer_meta" gst_buffer_add_parent_buffer_meta :: 
    Ptr Buffer ->                           -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    Ptr Buffer ->                           -- ref : TInterface (Name {namespace = "Gst", name = "Buffer"})
    IO (Ptr Gst.ParentBufferMeta.ParentBufferMeta)

-- | Adds a t'GI.Gst.Structs.ParentBufferMeta.ParentBufferMeta' to /@buffer@/ that holds a reference on
-- /@ref@/ until the buffer is freed.
-- 
-- /Since: 1.6/
bufferAddParentBufferMeta ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@buffer@/: a t'GI.Gst.Structs.Buffer.Buffer'
    -> Buffer
    -- ^ /@ref@/: a t'GI.Gst.Structs.Buffer.Buffer' to ref
    -> m (Maybe Gst.ParentBufferMeta.ParentBufferMeta)
    -- ^ __Returns:__ The t'GI.Gst.Structs.ParentBufferMeta.ParentBufferMeta' that was added to the buffer
bufferAddParentBufferMeta :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Buffer -> Buffer -> m (Maybe ParentBufferMeta)
bufferAddParentBufferMeta Buffer
buffer Buffer
ref = IO (Maybe ParentBufferMeta) -> m (Maybe ParentBufferMeta)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ParentBufferMeta) -> m (Maybe ParentBufferMeta))
-> IO (Maybe ParentBufferMeta) -> m (Maybe ParentBufferMeta)
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
    Ptr Buffer
ref' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
ref
    Ptr ParentBufferMeta
result <- Ptr Buffer -> Ptr Buffer -> IO (Ptr ParentBufferMeta)
gst_buffer_add_parent_buffer_meta Ptr Buffer
buffer' Ptr Buffer
ref'
    Maybe ParentBufferMeta
maybeResult <- Ptr ParentBufferMeta
-> (Ptr ParentBufferMeta -> IO ParentBufferMeta)
-> IO (Maybe ParentBufferMeta)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr ParentBufferMeta
result ((Ptr ParentBufferMeta -> IO ParentBufferMeta)
 -> IO (Maybe ParentBufferMeta))
-> (Ptr ParentBufferMeta -> IO ParentBufferMeta)
-> IO (Maybe ParentBufferMeta)
forall a b. (a -> b) -> a -> b
$ \Ptr ParentBufferMeta
result' -> do
        ParentBufferMeta
result'' <- ((ManagedPtr ParentBufferMeta -> ParentBufferMeta)
-> Ptr ParentBufferMeta -> IO ParentBufferMeta
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr ParentBufferMeta -> ParentBufferMeta
Gst.ParentBufferMeta.ParentBufferMeta) Ptr ParentBufferMeta
result'
        ParentBufferMeta -> IO ParentBufferMeta
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ParentBufferMeta
result''
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
ref
    Maybe ParentBufferMeta -> IO (Maybe ParentBufferMeta)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ParentBufferMeta
maybeResult

#if defined(ENABLE_OVERLOADING)
data BufferAddParentBufferMetaMethodInfo
instance (signature ~ (Buffer -> m (Maybe Gst.ParentBufferMeta.ParentBufferMeta)), MonadIO m) => O.OverloadedMethod BufferAddParentBufferMetaMethodInfo Buffer signature where
    overloadedMethod = bufferAddParentBufferMeta

instance O.OverloadedMethodInfo BufferAddParentBufferMetaMethodInfo Buffer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Buffer.bufferAddParentBufferMeta",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Buffer.html#v:bufferAddParentBufferMeta"
        })


#endif

-- method Buffer::add_protection_meta
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buffer"
--           , argType = TInterface Name { namespace = "Gst" , name = "Buffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "#GstBuffer holding an encrypted sample, to which protection\n    metadata should be added."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a #GstStructure holding cryptographic\n    information relating to the sample contained in @buffer. This\n    function takes ownership of @info."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gst" , name = "ProtectionMeta" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_add_protection_meta" gst_buffer_add_protection_meta :: 
    Ptr Buffer ->                           -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    Ptr Gst.Structure.Structure ->          -- info : TInterface (Name {namespace = "Gst", name = "Structure"})
    IO (Ptr Gst.ProtectionMeta.ProtectionMeta)

-- | Attaches protection metadata to a t'GI.Gst.Structs.Buffer.Buffer'.
-- 
-- /Since: 1.6/
bufferAddProtectionMeta ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@buffer@/: t'GI.Gst.Structs.Buffer.Buffer' holding an encrypted sample, to which protection
    --     metadata should be added.
    -> Gst.Structure.Structure
    -- ^ /@info@/: a t'GI.Gst.Structs.Structure.Structure' holding cryptographic
    --     information relating to the sample contained in /@buffer@/. This
    --     function takes ownership of /@info@/.
    -> m Gst.ProtectionMeta.ProtectionMeta
    -- ^ __Returns:__ a pointer to the added t'GI.Gst.Structs.ProtectionMeta.ProtectionMeta' if successful
bufferAddProtectionMeta :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Buffer -> Structure -> m ProtectionMeta
bufferAddProtectionMeta Buffer
buffer Structure
info = IO ProtectionMeta -> m ProtectionMeta
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ProtectionMeta -> m ProtectionMeta)
-> IO ProtectionMeta -> m ProtectionMeta
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
    Ptr Structure
info' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Structure
info
    Ptr ProtectionMeta
result <- Ptr Buffer -> Ptr Structure -> IO (Ptr ProtectionMeta)
gst_buffer_add_protection_meta Ptr Buffer
buffer' Ptr Structure
info'
    Text -> Ptr ProtectionMeta -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"bufferAddProtectionMeta" Ptr ProtectionMeta
result
    ProtectionMeta
result' <- ((ManagedPtr ProtectionMeta -> ProtectionMeta)
-> Ptr ProtectionMeta -> IO ProtectionMeta
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr ProtectionMeta -> ProtectionMeta
Gst.ProtectionMeta.ProtectionMeta) Ptr ProtectionMeta
result
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
info
    ProtectionMeta -> IO ProtectionMeta
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ProtectionMeta
result'

#if defined(ENABLE_OVERLOADING)
data BufferAddProtectionMetaMethodInfo
instance (signature ~ (Gst.Structure.Structure -> m Gst.ProtectionMeta.ProtectionMeta), MonadIO m) => O.OverloadedMethod BufferAddProtectionMetaMethodInfo Buffer signature where
    overloadedMethod = bufferAddProtectionMeta

instance O.OverloadedMethodInfo BufferAddProtectionMetaMethodInfo Buffer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Buffer.bufferAddProtectionMeta",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Buffer.html#v:bufferAddProtectionMeta"
        })


#endif

-- method Buffer::add_reference_timestamp_meta
-- method type : OrdinaryMethod
-- 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 = "reference"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "identifier for the timestamp reference."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timestamp"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "timestamp" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "duration"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "duration, or %GST_CLOCK_TIME_NONE"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Gst" , name = "ReferenceTimestampMeta" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_add_reference_timestamp_meta" gst_buffer_add_reference_timestamp_meta :: 
    Ptr Buffer ->                           -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    Ptr Gst.Caps.Caps ->                    -- reference : TInterface (Name {namespace = "Gst", name = "Caps"})
    Word64 ->                               -- timestamp : TBasicType TUInt64
    Word64 ->                               -- duration : TBasicType TUInt64
    IO (Ptr Gst.ReferenceTimestampMeta.ReferenceTimestampMeta)

-- | Adds a t'GI.Gst.Structs.ReferenceTimestampMeta.ReferenceTimestampMeta' to /@buffer@/ that holds a /@timestamp@/ and
-- optionally /@duration@/ based on a specific timestamp /@reference@/. See the
-- documentation of t'GI.Gst.Structs.ReferenceTimestampMeta.ReferenceTimestampMeta' for details.
-- 
-- /Since: 1.14/
bufferAddReferenceTimestampMeta ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@buffer@/: a t'GI.Gst.Structs.Buffer.Buffer'
    -> Gst.Caps.Caps
    -- ^ /@reference@/: identifier for the timestamp reference.
    -> Word64
    -- ^ /@timestamp@/: timestamp
    -> Word64
    -- ^ /@duration@/: duration, or 'GI.Gst.Constants.CLOCK_TIME_NONE'
    -> m (Maybe Gst.ReferenceTimestampMeta.ReferenceTimestampMeta)
    -- ^ __Returns:__ The t'GI.Gst.Structs.ReferenceTimestampMeta.ReferenceTimestampMeta' that was added to the buffer
bufferAddReferenceTimestampMeta :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Buffer
-> Caps -> Word64 -> Word64 -> m (Maybe ReferenceTimestampMeta)
bufferAddReferenceTimestampMeta Buffer
buffer Caps
reference Word64
timestamp Word64
duration = IO (Maybe ReferenceTimestampMeta)
-> m (Maybe ReferenceTimestampMeta)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ReferenceTimestampMeta)
 -> m (Maybe ReferenceTimestampMeta))
-> IO (Maybe ReferenceTimestampMeta)
-> m (Maybe ReferenceTimestampMeta)
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
    Ptr Caps
reference' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
reference
    Ptr ReferenceTimestampMeta
result <- Ptr Buffer
-> Ptr Caps -> Word64 -> Word64 -> IO (Ptr ReferenceTimestampMeta)
gst_buffer_add_reference_timestamp_meta Ptr Buffer
buffer' Ptr Caps
reference' Word64
timestamp Word64
duration
    Maybe ReferenceTimestampMeta
maybeResult <- Ptr ReferenceTimestampMeta
-> (Ptr ReferenceTimestampMeta -> IO ReferenceTimestampMeta)
-> IO (Maybe ReferenceTimestampMeta)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr ReferenceTimestampMeta
result ((Ptr ReferenceTimestampMeta -> IO ReferenceTimestampMeta)
 -> IO (Maybe ReferenceTimestampMeta))
-> (Ptr ReferenceTimestampMeta -> IO ReferenceTimestampMeta)
-> IO (Maybe ReferenceTimestampMeta)
forall a b. (a -> b) -> a -> b
$ \Ptr ReferenceTimestampMeta
result' -> do
        ReferenceTimestampMeta
result'' <- ((ManagedPtr ReferenceTimestampMeta -> ReferenceTimestampMeta)
-> Ptr ReferenceTimestampMeta -> IO ReferenceTimestampMeta
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr ReferenceTimestampMeta -> ReferenceTimestampMeta
Gst.ReferenceTimestampMeta.ReferenceTimestampMeta) Ptr ReferenceTimestampMeta
result'
        ReferenceTimestampMeta -> IO ReferenceTimestampMeta
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ReferenceTimestampMeta
result''
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
reference
    Maybe ReferenceTimestampMeta -> IO (Maybe ReferenceTimestampMeta)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ReferenceTimestampMeta
maybeResult

#if defined(ENABLE_OVERLOADING)
data BufferAddReferenceTimestampMetaMethodInfo
instance (signature ~ (Gst.Caps.Caps -> Word64 -> Word64 -> m (Maybe Gst.ReferenceTimestampMeta.ReferenceTimestampMeta)), MonadIO m) => O.OverloadedMethod BufferAddReferenceTimestampMetaMethodInfo Buffer signature where
    overloadedMethod = bufferAddReferenceTimestampMeta

instance O.OverloadedMethodInfo BufferAddReferenceTimestampMetaMethodInfo Buffer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Buffer.bufferAddReferenceTimestampMeta",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Buffer.html#v:bufferAddReferenceTimestampMeta"
        })


#endif

-- method Buffer::append
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buf1"
--           , argType = TInterface Name { namespace = "Gst" , name = "Buffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the first source #GstBuffer to append."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "buf2"
--           , argType = TInterface Name { namespace = "Gst" , name = "Buffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the second source #GstBuffer to append."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Buffer" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_append" gst_buffer_append :: 
    Ptr Buffer ->                           -- buf1 : TInterface (Name {namespace = "Gst", name = "Buffer"})
    Ptr Buffer ->                           -- buf2 : TInterface (Name {namespace = "Gst", name = "Buffer"})
    IO (Ptr Buffer)

-- | Appends all the memory from /@buf2@/ to /@buf1@/. The result buffer will contain a
-- concatenation of the memory of /@buf1@/ and /@buf2@/.
bufferAppend ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@buf1@/: the first source t'GI.Gst.Structs.Buffer.Buffer' to append.
    -> Buffer
    -- ^ /@buf2@/: the second source t'GI.Gst.Structs.Buffer.Buffer' to append.
    -> m Buffer
    -- ^ __Returns:__ the new t'GI.Gst.Structs.Buffer.Buffer' that contains the memory
    --     of the two source buffers.
bufferAppend :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Buffer -> Buffer -> m Buffer
bufferAppend Buffer
buf1 Buffer
buf2 = IO Buffer -> m Buffer
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Buffer -> m Buffer) -> IO Buffer -> m Buffer
forall a b. (a -> b) -> a -> b
$ do
    Ptr Buffer
buf1' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Buffer
buf1
    Ptr Buffer
buf2' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Buffer
buf2
    Ptr Buffer
result <- Ptr Buffer -> Ptr Buffer -> IO (Ptr Buffer)
gst_buffer_append Ptr Buffer
buf1' Ptr Buffer
buf2'
    Text -> Ptr Buffer -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"bufferAppend" Ptr Buffer
result
    Buffer
result' <- ((ManagedPtr Buffer -> Buffer) -> Ptr Buffer -> IO Buffer
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Buffer -> Buffer
Buffer) Ptr Buffer
result
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buf1
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buf2
    Buffer -> IO Buffer
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer
result'

#if defined(ENABLE_OVERLOADING)
data BufferAppendMethodInfo
instance (signature ~ (Buffer -> m Buffer), MonadIO m) => O.OverloadedMethod BufferAppendMethodInfo Buffer signature where
    overloadedMethod = bufferAppend

instance O.OverloadedMethodInfo BufferAppendMethodInfo Buffer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Buffer.bufferAppend",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Buffer.html#v:bufferAppend"
        })


#endif

-- method Buffer::append_memory
-- method type : OrdinaryMethod
-- 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 = "mem"
--           , argType = TInterface Name { namespace = "Gst" , name = "Memory" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstMemory." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_append_memory" gst_buffer_append_memory :: 
    Ptr Buffer ->                           -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    Ptr Gst.Memory.Memory ->                -- mem : TInterface (Name {namespace = "Gst", name = "Memory"})
    IO ()

-- | Appends the memory block /@mem@/ to /@buffer@/. This function takes
-- ownership of /@mem@/ and thus doesn\'t increase its refcount.
-- 
-- This function is identical to 'GI.Gst.Structs.Buffer.bufferInsertMemory' with an index of -1.
-- See 'GI.Gst.Structs.Buffer.bufferInsertMemory' for more details.
bufferAppendMemory ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@buffer@/: a t'GI.Gst.Structs.Buffer.Buffer'.
    -> Gst.Memory.Memory
    -- ^ /@mem@/: a t'GI.Gst.Structs.Memory.Memory'.
    -> m ()
bufferAppendMemory :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Buffer -> Memory -> m ()
bufferAppendMemory Buffer
buffer Memory
mem = 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 Buffer
buffer' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
buffer
    Ptr Memory
mem' <- Memory -> IO (Ptr Memory)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Memory
mem
    Ptr Buffer -> Ptr Memory -> IO ()
gst_buffer_append_memory Ptr Buffer
buffer' Ptr Memory
mem'
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    Memory -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Memory
mem
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BufferAppendMemoryMethodInfo
instance (signature ~ (Gst.Memory.Memory -> m ()), MonadIO m) => O.OverloadedMethod BufferAppendMemoryMethodInfo Buffer signature where
    overloadedMethod = bufferAppendMemory

instance O.OverloadedMethodInfo BufferAppendMemoryMethodInfo Buffer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Buffer.bufferAppendMemory",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Buffer.html#v:bufferAppendMemory"
        })


#endif

-- method Buffer::append_region
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buf1"
--           , argType = TInterface Name { namespace = "Gst" , name = "Buffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the first source #GstBuffer to append."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "buf2"
--           , argType = TInterface Name { namespace = "Gst" , name = "Buffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the second source #GstBuffer to append."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "offset"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the offset in @buf2"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "size"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the size or -1 of @buf2"
--                 , 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_buffer_append_region" gst_buffer_append_region :: 
    Ptr Buffer ->                           -- buf1 : TInterface (Name {namespace = "Gst", name = "Buffer"})
    Ptr Buffer ->                           -- buf2 : TInterface (Name {namespace = "Gst", name = "Buffer"})
    Int64 ->                                -- offset : TBasicType TInt64
    Int64 ->                                -- size : TBasicType TInt64
    IO (Ptr Buffer)

-- | Appends /@size@/ bytes at /@offset@/ from /@buf2@/ to /@buf1@/. The result buffer will
-- contain a concatenation of the memory of /@buf1@/ and the requested region of
-- /@buf2@/.
bufferAppendRegion ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@buf1@/: the first source t'GI.Gst.Structs.Buffer.Buffer' to append.
    -> Buffer
    -- ^ /@buf2@/: the second source t'GI.Gst.Structs.Buffer.Buffer' to append.
    -> Int64
    -- ^ /@offset@/: the offset in /@buf2@/
    -> Int64
    -- ^ /@size@/: the size or -1 of /@buf2@/
    -> m Buffer
    -- ^ __Returns:__ the new t'GI.Gst.Structs.Buffer.Buffer' that contains the memory
    --     of the two source buffers.
bufferAppendRegion :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Buffer -> Buffer -> Int64 -> Int64 -> m Buffer
bufferAppendRegion Buffer
buf1 Buffer
buf2 Int64
offset Int64
size = IO Buffer -> m Buffer
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Buffer -> m Buffer) -> IO Buffer -> m Buffer
forall a b. (a -> b) -> a -> b
$ do
    Ptr Buffer
buf1' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Buffer
buf1
    Ptr Buffer
buf2' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Buffer
buf2
    Ptr Buffer
result <- Ptr Buffer -> Ptr Buffer -> Int64 -> Int64 -> IO (Ptr Buffer)
gst_buffer_append_region Ptr Buffer
buf1' Ptr Buffer
buf2' Int64
offset Int64
size
    Text -> Ptr Buffer -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"bufferAppendRegion" Ptr Buffer
result
    Buffer
result' <- ((ManagedPtr Buffer -> Buffer) -> Ptr Buffer -> IO Buffer
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Buffer -> Buffer
Buffer) Ptr Buffer
result
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buf1
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buf2
    Buffer -> IO Buffer
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer
result'

#if defined(ENABLE_OVERLOADING)
data BufferAppendRegionMethodInfo
instance (signature ~ (Buffer -> Int64 -> Int64 -> m Buffer), MonadIO m) => O.OverloadedMethod BufferAppendRegionMethodInfo Buffer signature where
    overloadedMethod = bufferAppendRegion

instance O.OverloadedMethodInfo BufferAppendRegionMethodInfo Buffer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Buffer.bufferAppendRegion",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Buffer.html#v:bufferAppendRegion"
        })


#endif

-- method Buffer::copy_deep
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buf"
--           , 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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Buffer" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_copy_deep" gst_buffer_copy_deep :: 
    Ptr Buffer ->                           -- buf : TInterface (Name {namespace = "Gst", name = "Buffer"})
    IO (Ptr Buffer)

-- | Creates a copy of the given buffer. This will make a newly allocated
-- copy of the data the source buffer contains.
-- 
-- /Since: 1.6/
bufferCopyDeep ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@buf@/: a t'GI.Gst.Structs.Buffer.Buffer'.
    -> m Buffer
    -- ^ __Returns:__ a new copy of /@buf@/.
bufferCopyDeep :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Buffer -> m Buffer
bufferCopyDeep Buffer
buf = IO Buffer -> m Buffer
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Buffer -> m Buffer) -> IO Buffer -> m Buffer
forall a b. (a -> b) -> a -> b
$ do
    Ptr Buffer
buf' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
buf
    Ptr Buffer
result <- Ptr Buffer -> IO (Ptr Buffer)
gst_buffer_copy_deep Ptr Buffer
buf'
    Text -> Ptr Buffer -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"bufferCopyDeep" Ptr Buffer
result
    Buffer
result' <- ((ManagedPtr Buffer -> Buffer) -> Ptr Buffer -> IO Buffer
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Buffer -> Buffer
Buffer) Ptr Buffer
result
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buf
    Buffer -> IO Buffer
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer
result'

#if defined(ENABLE_OVERLOADING)
data BufferCopyDeepMethodInfo
instance (signature ~ (m Buffer), MonadIO m) => O.OverloadedMethod BufferCopyDeepMethodInfo Buffer signature where
    overloadedMethod = bufferCopyDeep

instance O.OverloadedMethodInfo BufferCopyDeepMethodInfo Buffer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Buffer.bufferCopyDeep",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Buffer.html#v:bufferCopyDeep"
        })


#endif

-- method Buffer::copy_into
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "dest"
--           , argType = TInterface Name { namespace = "Gst" , name = "Buffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a destination #GstBuffer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "src"
--           , argType = TInterface Name { namespace = "Gst" , name = "Buffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a source #GstBuffer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "BufferCopyFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "flags indicating what metadata fields should be copied."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "offset"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "offset to copy from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "size"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "total size to copy. If -1, all data is copied."
--                 , 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 "gst_buffer_copy_into" gst_buffer_copy_into :: 
    Ptr Buffer ->                           -- dest : TInterface (Name {namespace = "Gst", name = "Buffer"})
    Ptr Buffer ->                           -- src : TInterface (Name {namespace = "Gst", name = "Buffer"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gst", name = "BufferCopyFlags"})
    Word64 ->                               -- offset : TBasicType TUInt64
    Word64 ->                               -- size : TBasicType TUInt64
    IO CInt

-- | Copies the information from /@src@/ into /@dest@/.
-- 
-- If /@dest@/ already contains memory and /@flags@/ contains GST_BUFFER_COPY_MEMORY,
-- the memory from /@src@/ will be appended to /@dest@/.
-- 
-- /@flags@/ indicate which fields will be copied.
bufferCopyInto ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@dest@/: a destination t'GI.Gst.Structs.Buffer.Buffer'
    -> Buffer
    -- ^ /@src@/: a source t'GI.Gst.Structs.Buffer.Buffer'
    -> [Gst.Flags.BufferCopyFlags]
    -- ^ /@flags@/: flags indicating what metadata fields should be copied.
    -> Word64
    -- ^ /@offset@/: offset to copy from
    -> Word64
    -- ^ /@size@/: total size to copy. If -1, all data is copied.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the copying succeeded, 'P.False' otherwise.
bufferCopyInto :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Buffer -> Buffer -> [BufferCopyFlags] -> Word64 -> Word64 -> m Bool
bufferCopyInto Buffer
dest Buffer
src [BufferCopyFlags]
flags Word64
offset Word64
size = IO Bool -> m Bool
forall a. IO a -> m a
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 Buffer
dest' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
dest
    Ptr Buffer
src' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
src
    let flags' :: CUInt
flags' = [BufferCopyFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [BufferCopyFlags]
flags
    CInt
result <- Ptr Buffer -> Ptr Buffer -> CUInt -> Word64 -> Word64 -> IO CInt
gst_buffer_copy_into Ptr Buffer
dest' Ptr Buffer
src' CUInt
flags' Word64
offset Word64
size
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
dest
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
src
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BufferCopyIntoMethodInfo
instance (signature ~ (Buffer -> [Gst.Flags.BufferCopyFlags] -> Word64 -> Word64 -> m Bool), MonadIO m) => O.OverloadedMethod BufferCopyIntoMethodInfo Buffer signature where
    overloadedMethod = bufferCopyInto

instance O.OverloadedMethodInfo BufferCopyIntoMethodInfo Buffer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Buffer.bufferCopyInto",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Buffer.html#v:bufferCopyInto"
        })


#endif

-- method Buffer::copy_region
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "parent"
--           , 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 = "Gst" , name = "BufferCopyFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstBufferCopyFlags"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "offset"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the offset into parent #GstBuffer at which the new sub-buffer\n         begins."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "size"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the size of the new #GstBuffer sub-buffer, in bytes. If -1, all\n       data is copied."
--                 , 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_buffer_copy_region" gst_buffer_copy_region :: 
    Ptr Buffer ->                           -- parent : TInterface (Name {namespace = "Gst", name = "Buffer"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gst", name = "BufferCopyFlags"})
    Word64 ->                               -- offset : TBasicType TUInt64
    Word64 ->                               -- size : TBasicType TUInt64
    IO (Ptr Buffer)

-- | Creates a sub-buffer from /@parent@/ at /@offset@/ and /@size@/.
-- This sub-buffer uses the actual memory space of the parent buffer.
-- This function will copy the offset and timestamp fields when the
-- offset is 0. If not, they will be set to 'GI.Gst.Constants.CLOCK_TIME_NONE' and
-- 'GI.Gst.Constants.BUFFER_OFFSET_NONE'.
-- If /@offset@/ equals 0 and /@size@/ equals the total size of /@buffer@/, the
-- duration and offset end fields are also copied. If not they will be set
-- to 'GI.Gst.Constants.CLOCK_TIME_NONE' and 'GI.Gst.Constants.BUFFER_OFFSET_NONE'.
bufferCopyRegion ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@parent@/: a t'GI.Gst.Structs.Buffer.Buffer'.
    -> [Gst.Flags.BufferCopyFlags]
    -- ^ /@flags@/: the t'GI.Gst.Flags.BufferCopyFlags'
    -> Word64
    -- ^ /@offset@/: the offset into parent t'GI.Gst.Structs.Buffer.Buffer' at which the new sub-buffer
    --          begins.
    -> Word64
    -- ^ /@size@/: the size of the new t'GI.Gst.Structs.Buffer.Buffer' sub-buffer, in bytes. If -1, all
    --        data is copied.
    -> m Buffer
    -- ^ __Returns:__ the new t'GI.Gst.Structs.Buffer.Buffer' or 'P.Nothing' if the arguments were
    --     invalid.
bufferCopyRegion :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Buffer -> [BufferCopyFlags] -> Word64 -> Word64 -> m Buffer
bufferCopyRegion Buffer
parent [BufferCopyFlags]
flags Word64
offset Word64
size = IO Buffer -> m Buffer
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Buffer -> m Buffer) -> IO Buffer -> m Buffer
forall a b. (a -> b) -> a -> b
$ do
    Ptr Buffer
parent' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
parent
    let flags' :: CUInt
flags' = [BufferCopyFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [BufferCopyFlags]
flags
    Ptr Buffer
result <- Ptr Buffer -> CUInt -> Word64 -> Word64 -> IO (Ptr Buffer)
gst_buffer_copy_region Ptr Buffer
parent' CUInt
flags' Word64
offset Word64
size
    Text -> Ptr Buffer -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"bufferCopyRegion" Ptr Buffer
result
    Buffer
result' <- ((ManagedPtr Buffer -> Buffer) -> Ptr Buffer -> IO Buffer
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Buffer -> Buffer
Buffer) Ptr Buffer
result
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
parent
    Buffer -> IO Buffer
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer
result'

#if defined(ENABLE_OVERLOADING)
data BufferCopyRegionMethodInfo
instance (signature ~ ([Gst.Flags.BufferCopyFlags] -> Word64 -> Word64 -> m Buffer), MonadIO m) => O.OverloadedMethod BufferCopyRegionMethodInfo Buffer signature where
    overloadedMethod = bufferCopyRegion

instance O.OverloadedMethodInfo BufferCopyRegionMethodInfo Buffer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Buffer.bufferCopyRegion",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Buffer.html#v:bufferCopyRegion"
        })


#endif

-- method Buffer::extract
-- method type : OrdinaryMethod
-- 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 = "offset"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the offset to extract"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dest"
--           , argType = TCArray False (-1) 3 (TBasicType TUInt8)
--           , direction = DirectionOut
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "\n    the destination address"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "size"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the size to extract"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "size"
--              , argType = TBasicType TUInt64
--              , direction = DirectionOut
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the size to extract"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferEverything
--              }
--          ]
-- returnType: Just (TBasicType TUInt64)
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_extract" gst_buffer_extract :: 
    Ptr Buffer ->                           -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    Word64 ->                               -- offset : TBasicType TUInt64
    Ptr Word8 ->                            -- dest : TCArray False (-1) 3 (TBasicType TUInt8)
    Word64 ->                               -- size : TBasicType TUInt64
    IO Word64

-- | Copies /@size@/ bytes starting from /@offset@/ in /@buffer@/ to /@dest@/.
bufferExtract ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@buffer@/: a t'GI.Gst.Structs.Buffer.Buffer'.
    -> Word64
    -- ^ /@offset@/: the offset to extract
    -> Maybe (ByteString)
    -- ^ /@dest@/: 
    --     the destination address
    -> m ((Word64, Maybe ByteString))
    -- ^ __Returns:__ The amount of bytes extracted. This value can be lower than /@size@/
    --    when /@buffer@/ did not contain enough data.
bufferExtract :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Buffer
-> Word64 -> Maybe ByteString -> m (Word64, Maybe ByteString)
bufferExtract Buffer
buffer Word64
offset Maybe ByteString
dest = IO (Word64, Maybe ByteString) -> m (Word64, Maybe ByteString)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Word64, Maybe ByteString) -> m (Word64, Maybe ByteString))
-> IO (Word64, Maybe ByteString) -> m (Word64, Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ do
    let size :: Word64
size = case Maybe ByteString
dest of
            Maybe ByteString
Nothing -> Word64
0
            Just ByteString
jDest -> Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
jDest
    Ptr Buffer
buffer' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
buffer
    Ptr Word8
maybeDest <- case Maybe ByteString
dest of
        Maybe ByteString
Nothing -> Ptr Word8 -> IO (Ptr Word8)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Word8
forall a. Ptr a
nullPtr
        Just ByteString
jDest -> do
            Ptr Word8
jDest' <- ByteString -> IO (Ptr Word8)
packByteString ByteString
jDest
            Ptr Word8 -> IO (Ptr Word8)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Word8
jDest'
    Word64
result <- Ptr Buffer -> Word64 -> Ptr Word8 -> Word64 -> IO Word64
gst_buffer_extract Ptr Buffer
buffer' Word64
offset Ptr Word8
maybeDest Word64
size
    Maybe ByteString
maybeMaybeDest <- Ptr Word8 -> (Ptr Word8 -> IO ByteString) -> IO (Maybe ByteString)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Word8
maybeDest ((Ptr Word8 -> IO ByteString) -> IO (Maybe ByteString))
-> (Ptr Word8 -> IO ByteString) -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
maybeDest' -> do
        ByteString
maybeDest'' <- (Word64 -> Ptr Word8 -> IO ByteString
forall a. Integral a => a -> Ptr Word8 -> IO ByteString
unpackByteStringWithLength Word64
size) Ptr Word8
maybeDest'
        Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
maybeDest'
        ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
maybeDest''
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    (Word64, Maybe ByteString) -> IO (Word64, Maybe ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64
result, Maybe ByteString
maybeMaybeDest)

#if defined(ENABLE_OVERLOADING)
data BufferExtractMethodInfo
instance (signature ~ (Word64 -> Maybe (ByteString) -> m ((Word64, Maybe ByteString))), MonadIO m) => O.OverloadedMethod BufferExtractMethodInfo Buffer signature where
    overloadedMethod = bufferExtract

instance O.OverloadedMethodInfo BufferExtractMethodInfo Buffer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Buffer.bufferExtract",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Buffer.html#v:bufferExtract"
        })


#endif

-- method Buffer::extract_dup
-- method type : OrdinaryMethod
-- 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 = "offset"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the offset to extract"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "size"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the size to extract"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dest"
--           , argType = TCArray False (-1) 4 (TBasicType TUInt8)
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A pointer where\n the destination array will be written. Might be %NULL if the size is 0."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "dest_size"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A location where the size of @dest can be written"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "dest_size"
--              , argType = TBasicType TUInt64
--              , direction = DirectionOut
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText =
--                        Just "A location where the size of @dest can be written"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferEverything
--              }
--          ]
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_extract_dup" gst_buffer_extract_dup :: 
    Ptr Buffer ->                           -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    Word64 ->                               -- offset : TBasicType TUInt64
    Word64 ->                               -- size : TBasicType TUInt64
    Ptr (Ptr Word8) ->                      -- dest : TCArray False (-1) 4 (TBasicType TUInt8)
    Ptr Word64 ->                           -- dest_size : TBasicType TUInt64
    IO ()

-- | Extracts a copy of at most /@size@/ bytes the data at /@offset@/ into
-- newly-allocated memory. /@dest@/ must be freed using 'GI.GLib.Functions.free' when done.
-- 
-- /Since: 1.0.10/
bufferExtractDup ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@buffer@/: a t'GI.Gst.Structs.Buffer.Buffer'
    -> Word64
    -- ^ /@offset@/: the offset to extract
    -> Word64
    -- ^ /@size@/: the size to extract
    -> m (ByteString)
bufferExtractDup :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Buffer -> Word64 -> Word64 -> m ByteString
bufferExtractDup Buffer
buffer Word64
offset Word64
size = IO ByteString -> m ByteString
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
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
    Ptr (Ptr Word8)
dest <- IO (Ptr (Ptr Word8))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Word8))
    Ptr Word64
destSize <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Buffer
-> Word64 -> Word64 -> Ptr (Ptr Word8) -> Ptr Word64 -> IO ()
gst_buffer_extract_dup Ptr Buffer
buffer' Word64
offset Word64
size Ptr (Ptr Word8)
dest Ptr Word64
destSize
    Word64
destSize' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
destSize
    Ptr Word8
dest' <- Ptr (Ptr Word8) -> IO (Ptr Word8)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Word8)
dest
    ByteString
dest'' <- (Word64 -> Ptr Word8 -> IO ByteString
forall a. Integral a => a -> Ptr Word8 -> IO ByteString
unpackByteStringWithLength Word64
destSize') Ptr Word8
dest'
    Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
dest'
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    Ptr (Ptr Word8) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Word8)
dest
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
destSize
    ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
dest''

#if defined(ENABLE_OVERLOADING)
data BufferExtractDupMethodInfo
instance (signature ~ (Word64 -> Word64 -> m (ByteString)), MonadIO m) => O.OverloadedMethod BufferExtractDupMethodInfo Buffer signature where
    overloadedMethod = bufferExtractDup

instance O.OverloadedMethodInfo BufferExtractDupMethodInfo Buffer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Buffer.bufferExtractDup",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Buffer.html#v:bufferExtractDup"
        })


#endif

-- method Buffer::fill
-- method type : OrdinaryMethod
-- 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 = "offset"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the offset to fill" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "src"
--           , argType = TCArray False (-1) 3 (TBasicType TUInt8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the source address" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "size"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the size to fill" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "size"
--              , argType = TBasicType TUInt64
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the size to fill" , sinceVersion = Nothing }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just (TBasicType TUInt64)
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_fill" gst_buffer_fill :: 
    Ptr Buffer ->                           -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    Word64 ->                               -- offset : TBasicType TUInt64
    Ptr Word8 ->                            -- src : TCArray False (-1) 3 (TBasicType TUInt8)
    Word64 ->                               -- size : TBasicType TUInt64
    IO Word64

-- | Copies /@size@/ bytes from /@src@/ to /@buffer@/ at /@offset@/.
bufferFill ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@buffer@/: a t'GI.Gst.Structs.Buffer.Buffer'.
    -> Word64
    -- ^ /@offset@/: the offset to fill
    -> ByteString
    -- ^ /@src@/: the source address
    -> m Word64
    -- ^ __Returns:__ The amount of bytes copied. This value can be lower than /@size@/
    --    when /@buffer@/ did not contain enough data.
bufferFill :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Buffer -> Word64 -> ByteString -> m Word64
bufferFill Buffer
buffer Word64
offset ByteString
src = 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
$ do
    let size :: Word64
size = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
src
    Ptr Buffer
buffer' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
buffer
    Ptr Word8
src' <- ByteString -> IO (Ptr Word8)
packByteString ByteString
src
    Word64
result <- Ptr Buffer -> Word64 -> Ptr Word8 -> Word64 -> IO Word64
gst_buffer_fill Ptr Buffer
buffer' Word64
offset Ptr Word8
src' Word64
size
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
src'
    Word64 -> IO Word64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data BufferFillMethodInfo
instance (signature ~ (Word64 -> ByteString -> m Word64), MonadIO m) => O.OverloadedMethod BufferFillMethodInfo Buffer signature where
    overloadedMethod = bufferFill

instance O.OverloadedMethodInfo BufferFillMethodInfo Buffer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Buffer.bufferFill",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Buffer.html#v:bufferFill"
        })


#endif

-- method Buffer::find_memory
-- method type : OrdinaryMethod
-- 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 = "offset"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an offset" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "size"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a size" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "idx"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "pointer to index" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "pointer to length" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "skip"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "pointer to skip" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_find_memory" gst_buffer_find_memory :: 
    Ptr Buffer ->                           -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    Word64 ->                               -- offset : TBasicType TUInt64
    Word64 ->                               -- size : TBasicType TUInt64
    Ptr Word32 ->                           -- idx : TBasicType TUInt
    Ptr Word32 ->                           -- length : TBasicType TUInt
    Ptr Word64 ->                           -- skip : TBasicType TUInt64
    IO CInt

-- | Finds the memory blocks that span /@size@/ bytes starting from /@offset@/
-- in /@buffer@/.
-- 
-- When this function returns 'P.True', /@idx@/ will contain the index of the first
-- memory block where the byte for /@offset@/ can be found and /@length@/ contains the
-- number of memory blocks containing the /@size@/ remaining bytes. /@skip@/ contains
-- the number of bytes to skip in the memory block at /@idx@/ to get to the byte
-- for /@offset@/.
-- 
-- /@size@/ can be -1 to get all the memory blocks after /@idx@/.
bufferFindMemory ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@buffer@/: a t'GI.Gst.Structs.Buffer.Buffer'.
    -> Word64
    -- ^ /@offset@/: an offset
    -> Word64
    -- ^ /@size@/: a size
    -> m ((Bool, Word32, Word32, Word64))
    -- ^ __Returns:__ 'P.True' when /@size@/ bytes starting from /@offset@/ could be found in
    -- /@buffer@/ and /@idx@/, /@length@/ and /@skip@/ will be filled.
bufferFindMemory :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Buffer -> Word64 -> Word64 -> m (Bool, Word32, Word32, Word64)
bufferFindMemory Buffer
buffer Word64
offset Word64
size = IO (Bool, Word32, Word32, Word64)
-> m (Bool, Word32, Word32, Word64)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Word32, Word32, Word64)
 -> m (Bool, Word32, Word32, Word64))
-> IO (Bool, Word32, Word32, Word64)
-> m (Bool, Word32, Word32, Word64)
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
    Ptr Word32
idx <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    Ptr Word32
length_ <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    Ptr Word64
skip <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    CInt
result <- Ptr Buffer
-> Word64
-> Word64
-> Ptr Word32
-> Ptr Word32
-> Ptr Word64
-> IO CInt
gst_buffer_find_memory Ptr Buffer
buffer' Word64
offset Word64
size Ptr Word32
idx Ptr Word32
length_ Ptr Word64
skip
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Word32
idx' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
idx
    Word32
length_' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
length_
    Word64
skip' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
skip
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
idx
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
length_
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
skip
    (Bool, Word32, Word32, Word64) -> IO (Bool, Word32, Word32, Word64)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Word32
idx', Word32
length_', Word64
skip')

#if defined(ENABLE_OVERLOADING)
data BufferFindMemoryMethodInfo
instance (signature ~ (Word64 -> Word64 -> m ((Bool, Word32, Word32, Word64))), MonadIO m) => O.OverloadedMethod BufferFindMemoryMethodInfo Buffer signature where
    overloadedMethod = bufferFindMemory

instance O.OverloadedMethodInfo BufferFindMemoryMethodInfo Buffer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Buffer.bufferFindMemory",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Buffer.html#v:bufferFindMemory"
        })


#endif

-- method Buffer::foreach_meta
-- method type : OrdinaryMethod
-- 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 = "func"
--           , argType =
--               TInterface
--                 Name { namespace = "Gst" , name = "BufferForeachMetaFunc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBufferForeachMetaFunc to call"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeCall
--           , argClosure = 2
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data passed to @func"
--                 , 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 "gst_buffer_foreach_meta" gst_buffer_foreach_meta :: 
    Ptr Buffer ->                           -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    FunPtr Gst.Callbacks.C_BufferForeachMetaFunc -> -- func : TInterface (Name {namespace = "Gst", name = "BufferForeachMetaFunc"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO CInt

-- | Calls /@func@/ with /@userData@/ for each meta in /@buffer@/.
-- 
-- /@func@/ can modify the passed meta pointer or its contents. The return value
-- of /@func@/ defines if this function returns or if the remaining metadata items
-- in the buffer should be skipped.
bufferForeachMeta ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@buffer@/: a t'GI.Gst.Structs.Buffer.Buffer'
    -> Gst.Callbacks.BufferForeachMetaFunc
    -- ^ /@func@/: a t'GI.Gst.Callbacks.BufferForeachMetaFunc' to call
    -> m Bool
    -- ^ __Returns:__ 'P.False' when /@func@/ returned 'P.False' for one of the metadata.
bufferForeachMeta :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Buffer -> BufferForeachMetaFunc -> m Bool
bufferForeachMeta Buffer
buffer BufferForeachMetaFunc
func = IO Bool -> m Bool
forall a. IO a -> m a
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 Buffer
buffer' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
buffer
    FunPtr C_BufferForeachMetaFunc
func' <- C_BufferForeachMetaFunc -> IO (FunPtr C_BufferForeachMetaFunc)
Gst.Callbacks.mk_BufferForeachMetaFunc (Maybe (Ptr (FunPtr C_BufferForeachMetaFunc))
-> BufferForeachMetaFunc_WithClosures -> C_BufferForeachMetaFunc
Gst.Callbacks.wrap_BufferForeachMetaFunc Maybe (Ptr (FunPtr C_BufferForeachMetaFunc))
forall a. Maybe a
Nothing (BufferForeachMetaFunc -> BufferForeachMetaFunc_WithClosures
Gst.Callbacks.drop_closures_BufferForeachMetaFunc BufferForeachMetaFunc
func))
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    CInt
result <- Ptr Buffer -> FunPtr C_BufferForeachMetaFunc -> Ptr () -> IO CInt
gst_buffer_foreach_meta Ptr Buffer
buffer' FunPtr C_BufferForeachMetaFunc
func' Ptr ()
forall a. Ptr a
userData
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_BufferForeachMetaFunc -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_BufferForeachMetaFunc
func'
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BufferForeachMetaMethodInfo
instance (signature ~ (Gst.Callbacks.BufferForeachMetaFunc -> m Bool), MonadIO m) => O.OverloadedMethod BufferForeachMetaMethodInfo Buffer signature where
    overloadedMethod = bufferForeachMeta

instance O.OverloadedMethodInfo BufferForeachMetaMethodInfo Buffer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Buffer.bufferForeachMeta",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Buffer.html#v:bufferForeachMeta"
        })


#endif

-- method Buffer::get_all_memory
-- method type : OrdinaryMethod
-- 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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Memory" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_get_all_memory" gst_buffer_get_all_memory :: 
    Ptr Buffer ->                           -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    IO (Ptr Gst.Memory.Memory)

-- | Gets all the memory blocks in /@buffer@/. The memory blocks will be merged
-- into one large t'GI.Gst.Structs.Memory.Memory'.
bufferGetAllMemory ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@buffer@/: a t'GI.Gst.Structs.Buffer.Buffer'.
    -> m (Maybe Gst.Memory.Memory)
    -- ^ __Returns:__ a t'GI.Gst.Structs.Memory.Memory' that contains the merged memory.
bufferGetAllMemory :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Buffer -> m (Maybe Memory)
bufferGetAllMemory Buffer
buffer = IO (Maybe Memory) -> m (Maybe Memory)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Memory) -> m (Maybe Memory))
-> IO (Maybe Memory) -> m (Maybe Memory)
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
    Ptr Memory
result <- Ptr Buffer -> IO (Ptr Memory)
gst_buffer_get_all_memory Ptr Buffer
buffer'
    Maybe Memory
maybeResult <- Ptr Memory -> (Ptr Memory -> IO Memory) -> IO (Maybe Memory)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Memory
result ((Ptr Memory -> IO Memory) -> IO (Maybe Memory))
-> (Ptr Memory -> IO Memory) -> IO (Maybe Memory)
forall a b. (a -> b) -> a -> b
$ \Ptr Memory
result' -> do
        Memory
result'' <- ((ManagedPtr Memory -> Memory) -> Ptr Memory -> IO Memory
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Memory -> Memory
Gst.Memory.Memory) Ptr Memory
result'
        Memory -> IO Memory
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Memory
result''
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    Maybe Memory -> IO (Maybe Memory)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Memory
maybeResult

#if defined(ENABLE_OVERLOADING)
data BufferGetAllMemoryMethodInfo
instance (signature ~ (m (Maybe Gst.Memory.Memory)), MonadIO m) => O.OverloadedMethod BufferGetAllMemoryMethodInfo Buffer signature where
    overloadedMethod = bufferGetAllMemory

instance O.OverloadedMethodInfo BufferGetAllMemoryMethodInfo Buffer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Buffer.bufferGetAllMemory",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Buffer.html#v:bufferGetAllMemory"
        })


#endif

-- method Buffer::get_custom_meta
-- method type : OrdinaryMethod
-- 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 = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the registered name of the custom meta to retrieve."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "CustomMeta" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_get_custom_meta" gst_buffer_get_custom_meta :: 
    Ptr Buffer ->                           -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    CString ->                              -- name : TBasicType TUTF8
    IO (Ptr Gst.CustomMeta.CustomMeta)

-- | Finds the first t'GI.Gst.Structs.CustomMeta.CustomMeta' on /@buffer@/ for the desired /@name@/.
-- 
-- /Since: 1.20/
bufferGetCustomMeta ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@buffer@/: a t'GI.Gst.Structs.Buffer.Buffer'
    -> T.Text
    -- ^ /@name@/: the registered name of the custom meta to retrieve.
    -> m (Maybe Gst.CustomMeta.CustomMeta)
    -- ^ __Returns:__ the t'GI.Gst.Structs.CustomMeta.CustomMeta'
bufferGetCustomMeta :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Buffer -> Text -> m (Maybe CustomMeta)
bufferGetCustomMeta Buffer
buffer Text
name = IO (Maybe CustomMeta) -> m (Maybe CustomMeta)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe CustomMeta) -> m (Maybe CustomMeta))
-> IO (Maybe CustomMeta) -> m (Maybe CustomMeta)
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
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr CustomMeta
result <- Ptr Buffer -> CString -> IO (Ptr CustomMeta)
gst_buffer_get_custom_meta Ptr Buffer
buffer' CString
name'
    Maybe CustomMeta
maybeResult <- Ptr CustomMeta
-> (Ptr CustomMeta -> IO CustomMeta) -> IO (Maybe CustomMeta)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr CustomMeta
result ((Ptr CustomMeta -> IO CustomMeta) -> IO (Maybe CustomMeta))
-> (Ptr CustomMeta -> IO CustomMeta) -> IO (Maybe CustomMeta)
forall a b. (a -> b) -> a -> b
$ \Ptr CustomMeta
result' -> do
        CustomMeta
result'' <- ((ManagedPtr CustomMeta -> CustomMeta)
-> Ptr CustomMeta -> IO CustomMeta
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr CustomMeta -> CustomMeta
Gst.CustomMeta.CustomMeta) Ptr CustomMeta
result'
        CustomMeta -> IO CustomMeta
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CustomMeta
result''
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Maybe CustomMeta -> IO (Maybe CustomMeta)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe CustomMeta
maybeResult

#if defined(ENABLE_OVERLOADING)
data BufferGetCustomMetaMethodInfo
instance (signature ~ (T.Text -> m (Maybe Gst.CustomMeta.CustomMeta)), MonadIO m) => O.OverloadedMethod BufferGetCustomMetaMethodInfo Buffer signature where
    overloadedMethod = bufferGetCustomMeta

instance O.OverloadedMethodInfo BufferGetCustomMetaMethodInfo Buffer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Buffer.bufferGetCustomMeta",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Buffer.html#v:bufferGetCustomMeta"
        })


#endif

-- method Buffer::get_flags
-- method type : OrdinaryMethod
-- 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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "BufferFlags" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_get_flags" gst_buffer_get_flags :: 
    Ptr Buffer ->                           -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    IO CUInt

-- | Gets the t'GI.Gst.Flags.BufferFlags' flags set on this buffer.
-- 
-- /Since: 1.10/
bufferGetFlags ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@buffer@/: a t'GI.Gst.Structs.Buffer.Buffer'
    -> m [Gst.Flags.BufferFlags]
    -- ^ __Returns:__ the flags set on this buffer.
bufferGetFlags :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Buffer -> m [BufferFlags]
bufferGetFlags Buffer
buffer = IO [BufferFlags] -> m [BufferFlags]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [BufferFlags] -> m [BufferFlags])
-> IO [BufferFlags] -> m [BufferFlags]
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
    CUInt
result <- Ptr Buffer -> IO CUInt
gst_buffer_get_flags Ptr Buffer
buffer'
    let result' :: [BufferFlags]
result' = CUInt -> [BufferFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    [BufferFlags] -> IO [BufferFlags]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [BufferFlags]
result'

#if defined(ENABLE_OVERLOADING)
data BufferGetFlagsMethodInfo
instance (signature ~ (m [Gst.Flags.BufferFlags]), MonadIO m) => O.OverloadedMethod BufferGetFlagsMethodInfo Buffer signature where
    overloadedMethod = bufferGetFlags

instance O.OverloadedMethodInfo BufferGetFlagsMethodInfo Buffer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Buffer.bufferGetFlags",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Buffer.html#v:bufferGetFlags"
        })


#endif

-- method Buffer::get_memory
-- method type : OrdinaryMethod
-- 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 = "idx"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an index" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Memory" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_get_memory" gst_buffer_get_memory :: 
    Ptr Buffer ->                           -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    Word32 ->                               -- idx : TBasicType TUInt
    IO (Ptr Gst.Memory.Memory)

-- | Gets the memory block at index /@idx@/ in /@buffer@/.
bufferGetMemory ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@buffer@/: a t'GI.Gst.Structs.Buffer.Buffer'.
    -> Word32
    -- ^ /@idx@/: an index
    -> m (Maybe Gst.Memory.Memory)
    -- ^ __Returns:__ a t'GI.Gst.Structs.Memory.Memory' that contains the data of the
    -- memory block at /@idx@/.
bufferGetMemory :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Buffer -> Word32 -> m (Maybe Memory)
bufferGetMemory Buffer
buffer Word32
idx = IO (Maybe Memory) -> m (Maybe Memory)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Memory) -> m (Maybe Memory))
-> IO (Maybe Memory) -> m (Maybe Memory)
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
    Ptr Memory
result <- Ptr Buffer -> Word32 -> IO (Ptr Memory)
gst_buffer_get_memory Ptr Buffer
buffer' Word32
idx
    Maybe Memory
maybeResult <- Ptr Memory -> (Ptr Memory -> IO Memory) -> IO (Maybe Memory)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Memory
result ((Ptr Memory -> IO Memory) -> IO (Maybe Memory))
-> (Ptr Memory -> IO Memory) -> IO (Maybe Memory)
forall a b. (a -> b) -> a -> b
$ \Ptr Memory
result' -> do
        Memory
result'' <- ((ManagedPtr Memory -> Memory) -> Ptr Memory -> IO Memory
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Memory -> Memory
Gst.Memory.Memory) Ptr Memory
result'
        Memory -> IO Memory
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Memory
result''
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    Maybe Memory -> IO (Maybe Memory)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Memory
maybeResult

#if defined(ENABLE_OVERLOADING)
data BufferGetMemoryMethodInfo
instance (signature ~ (Word32 -> m (Maybe Gst.Memory.Memory)), MonadIO m) => O.OverloadedMethod BufferGetMemoryMethodInfo Buffer signature where
    overloadedMethod = bufferGetMemory

instance O.OverloadedMethodInfo BufferGetMemoryMethodInfo Buffer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Buffer.bufferGetMemory",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Buffer.html#v:bufferGetMemory"
        })


#endif

-- method Buffer::get_memory_range
-- method type : OrdinaryMethod
-- 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 = "idx"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an index" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a length" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Memory" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_get_memory_range" gst_buffer_get_memory_range :: 
    Ptr Buffer ->                           -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    Word32 ->                               -- idx : TBasicType TUInt
    Int32 ->                                -- length : TBasicType TInt
    IO (Ptr Gst.Memory.Memory)

-- | Gets /@length@/ memory blocks in /@buffer@/ starting at /@idx@/. The memory blocks will
-- be merged into one large t'GI.Gst.Structs.Memory.Memory'.
-- 
-- If /@length@/ is -1, all memory starting from /@idx@/ is merged.
bufferGetMemoryRange ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@buffer@/: a t'GI.Gst.Structs.Buffer.Buffer'.
    -> Word32
    -- ^ /@idx@/: an index
    -> Int32
    -- ^ /@length@/: a length
    -> m (Maybe Gst.Memory.Memory)
    -- ^ __Returns:__ a t'GI.Gst.Structs.Memory.Memory' that contains the merged data of /@length@/
    --    blocks starting at /@idx@/.
bufferGetMemoryRange :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Buffer -> Word32 -> Int32 -> m (Maybe Memory)
bufferGetMemoryRange Buffer
buffer Word32
idx Int32
length_ = IO (Maybe Memory) -> m (Maybe Memory)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Memory) -> m (Maybe Memory))
-> IO (Maybe Memory) -> m (Maybe Memory)
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
    Ptr Memory
result <- Ptr Buffer -> Word32 -> Int32 -> IO (Ptr Memory)
gst_buffer_get_memory_range Ptr Buffer
buffer' Word32
idx Int32
length_
    Maybe Memory
maybeResult <- Ptr Memory -> (Ptr Memory -> IO Memory) -> IO (Maybe Memory)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Memory
result ((Ptr Memory -> IO Memory) -> IO (Maybe Memory))
-> (Ptr Memory -> IO Memory) -> IO (Maybe Memory)
forall a b. (a -> b) -> a -> b
$ \Ptr Memory
result' -> do
        Memory
result'' <- ((ManagedPtr Memory -> Memory) -> Ptr Memory -> IO Memory
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Memory -> Memory
Gst.Memory.Memory) Ptr Memory
result'
        Memory -> IO Memory
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Memory
result''
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    Maybe Memory -> IO (Maybe Memory)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Memory
maybeResult

#if defined(ENABLE_OVERLOADING)
data BufferGetMemoryRangeMethodInfo
instance (signature ~ (Word32 -> Int32 -> m (Maybe Gst.Memory.Memory)), MonadIO m) => O.OverloadedMethod BufferGetMemoryRangeMethodInfo Buffer signature where
    overloadedMethod = bufferGetMemoryRange

instance O.OverloadedMethodInfo BufferGetMemoryRangeMethodInfo Buffer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Buffer.bufferGetMemoryRange",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Buffer.html#v:bufferGetMemoryRange"
        })


#endif

-- method Buffer::get_meta
-- method type : OrdinaryMethod
-- 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 = "api"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GType of an API"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Meta" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_get_meta" gst_buffer_get_meta :: 
    Ptr Buffer ->                           -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    CGType ->                               -- api : TBasicType TGType
    IO (Ptr Gst.Meta.Meta)

-- | Gets the metadata for /@api@/ on buffer. When there is no such metadata, 'P.Nothing' is
-- returned. If multiple metadata with the given /@api@/ are attached to this
-- buffer only the first one is returned.  To handle multiple metadata with a
-- given API use @/gst_buffer_iterate_meta()/@ or 'GI.Gst.Structs.Buffer.bufferForeachMeta' instead
-- and check the @meta->info.api@ member for the API type.
bufferGetMeta ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@buffer@/: a t'GI.Gst.Structs.Buffer.Buffer'
    -> GType
    -- ^ /@api@/: the t'GType' of an API
    -> m (Maybe Gst.Meta.Meta)
    -- ^ __Returns:__ the metadata for /@api@/ on /@buffer@/.
bufferGetMeta :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Buffer -> GType -> m (Maybe Meta)
bufferGetMeta Buffer
buffer GType
api = IO (Maybe Meta) -> m (Maybe Meta)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Meta) -> m (Maybe Meta))
-> IO (Maybe Meta) -> m (Maybe Meta)
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 api' :: Word64
api' = GType -> Word64
gtypeToCGType GType
api
    Ptr Meta
result <- Ptr Buffer -> Word64 -> IO (Ptr Meta)
gst_buffer_get_meta Ptr Buffer
buffer' Word64
api'
    Maybe Meta
maybeResult <- Ptr Meta -> (Ptr Meta -> IO Meta) -> IO (Maybe Meta)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Meta
result ((Ptr Meta -> IO Meta) -> IO (Maybe Meta))
-> (Ptr Meta -> IO Meta) -> IO (Maybe Meta)
forall a b. (a -> b) -> a -> b
$ \Ptr Meta
result' -> do
        Meta
result'' <- ((ManagedPtr Meta -> Meta) -> Ptr Meta -> IO Meta
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr Meta -> Meta
Gst.Meta.Meta) Ptr Meta
result'
        Meta -> IO Meta
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Meta
result''
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    Maybe Meta -> IO (Maybe Meta)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Meta
maybeResult

#if defined(ENABLE_OVERLOADING)
data BufferGetMetaMethodInfo
instance (signature ~ (GType -> m (Maybe Gst.Meta.Meta)), MonadIO m) => O.OverloadedMethod BufferGetMetaMethodInfo Buffer signature where
    overloadedMethod = bufferGetMeta

instance O.OverloadedMethodInfo BufferGetMetaMethodInfo Buffer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Buffer.bufferGetMeta",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Buffer.html#v:bufferGetMeta"
        })


#endif

-- method Buffer::get_n_meta
-- method type : OrdinaryMethod
-- 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 = "api_type"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GType of an API"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_get_n_meta" gst_buffer_get_n_meta :: 
    Ptr Buffer ->                           -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    CGType ->                               -- api_type : TBasicType TGType
    IO Word32

-- | /No description available in the introspection data./
-- 
-- /Since: 1.14/
bufferGetNMeta ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@buffer@/: a t'GI.Gst.Structs.Buffer.Buffer'
    -> GType
    -- ^ /@apiType@/: the t'GType' of an API
    -> m Word32
    -- ^ __Returns:__ number of metas of type /@apiType@/ on /@buffer@/.
bufferGetNMeta :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Buffer -> GType -> m Word32
bufferGetNMeta Buffer
buffer GType
apiType = 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
$ do
    Ptr Buffer
buffer' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
buffer
    let apiType' :: Word64
apiType' = GType -> Word64
gtypeToCGType GType
apiType
    Word32
result <- Ptr Buffer -> Word64 -> IO Word32
gst_buffer_get_n_meta Ptr Buffer
buffer' Word64
apiType'
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data BufferGetNMetaMethodInfo
instance (signature ~ (GType -> m Word32), MonadIO m) => O.OverloadedMethod BufferGetNMetaMethodInfo Buffer signature where
    overloadedMethod = bufferGetNMeta

instance O.OverloadedMethodInfo BufferGetNMetaMethodInfo Buffer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Buffer.bufferGetNMeta",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Buffer.html#v:bufferGetNMeta"
        })


#endif

-- method Buffer::get_reference_timestamp_meta
-- method type : OrdinaryMethod
-- 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 = "reference"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a reference #GstCaps"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Gst" , name = "ReferenceTimestampMeta" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_get_reference_timestamp_meta" gst_buffer_get_reference_timestamp_meta :: 
    Ptr Buffer ->                           -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    Ptr Gst.Caps.Caps ->                    -- reference : TInterface (Name {namespace = "Gst", name = "Caps"})
    IO (Ptr Gst.ReferenceTimestampMeta.ReferenceTimestampMeta)

-- | Finds the first t'GI.Gst.Structs.ReferenceTimestampMeta.ReferenceTimestampMeta' on /@buffer@/ that conforms to
-- /@reference@/. Conformance is tested by checking if the meta\'s reference is a
-- subset of /@reference@/.
-- 
-- Buffers can contain multiple t'GI.Gst.Structs.ReferenceTimestampMeta.ReferenceTimestampMeta' metadata items.
-- 
-- /Since: 1.14/
bufferGetReferenceTimestampMeta ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@buffer@/: a t'GI.Gst.Structs.Buffer.Buffer'
    -> Maybe (Gst.Caps.Caps)
    -- ^ /@reference@/: a reference t'GI.Gst.Structs.Caps.Caps'
    -> m (Maybe Gst.ReferenceTimestampMeta.ReferenceTimestampMeta)
    -- ^ __Returns:__ the t'GI.Gst.Structs.ReferenceTimestampMeta.ReferenceTimestampMeta' or 'P.Nothing' when there
    -- is no such metadata on /@buffer@/.
bufferGetReferenceTimestampMeta :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Buffer -> Maybe Caps -> m (Maybe ReferenceTimestampMeta)
bufferGetReferenceTimestampMeta Buffer
buffer Maybe Caps
reference = IO (Maybe ReferenceTimestampMeta)
-> m (Maybe ReferenceTimestampMeta)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ReferenceTimestampMeta)
 -> m (Maybe ReferenceTimestampMeta))
-> IO (Maybe ReferenceTimestampMeta)
-> m (Maybe ReferenceTimestampMeta)
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
    Ptr Caps
maybeReference <- case Maybe Caps
reference of
        Maybe Caps
Nothing -> Ptr Caps -> IO (Ptr Caps)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Caps
forall a. Ptr a
nullPtr
        Just Caps
jReference -> do
            Ptr Caps
jReference' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
jReference
            Ptr Caps -> IO (Ptr Caps)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Caps
jReference'
    Ptr ReferenceTimestampMeta
result <- Ptr Buffer -> Ptr Caps -> IO (Ptr ReferenceTimestampMeta)
gst_buffer_get_reference_timestamp_meta Ptr Buffer
buffer' Ptr Caps
maybeReference
    Maybe ReferenceTimestampMeta
maybeResult <- Ptr ReferenceTimestampMeta
-> (Ptr ReferenceTimestampMeta -> IO ReferenceTimestampMeta)
-> IO (Maybe ReferenceTimestampMeta)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr ReferenceTimestampMeta
result ((Ptr ReferenceTimestampMeta -> IO ReferenceTimestampMeta)
 -> IO (Maybe ReferenceTimestampMeta))
-> (Ptr ReferenceTimestampMeta -> IO ReferenceTimestampMeta)
-> IO (Maybe ReferenceTimestampMeta)
forall a b. (a -> b) -> a -> b
$ \Ptr ReferenceTimestampMeta
result' -> do
        ReferenceTimestampMeta
result'' <- ((ManagedPtr ReferenceTimestampMeta -> ReferenceTimestampMeta)
-> Ptr ReferenceTimestampMeta -> IO ReferenceTimestampMeta
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr ReferenceTimestampMeta -> ReferenceTimestampMeta
Gst.ReferenceTimestampMeta.ReferenceTimestampMeta) Ptr ReferenceTimestampMeta
result'
        ReferenceTimestampMeta -> IO ReferenceTimestampMeta
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ReferenceTimestampMeta
result''
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    Maybe Caps -> (Caps -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Caps
reference Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe ReferenceTimestampMeta -> IO (Maybe ReferenceTimestampMeta)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ReferenceTimestampMeta
maybeResult

#if defined(ENABLE_OVERLOADING)
data BufferGetReferenceTimestampMetaMethodInfo
instance (signature ~ (Maybe (Gst.Caps.Caps) -> m (Maybe Gst.ReferenceTimestampMeta.ReferenceTimestampMeta)), MonadIO m) => O.OverloadedMethod BufferGetReferenceTimestampMetaMethodInfo Buffer signature where
    overloadedMethod = bufferGetReferenceTimestampMeta

instance O.OverloadedMethodInfo BufferGetReferenceTimestampMetaMethodInfo Buffer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Buffer.bufferGetReferenceTimestampMeta",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Buffer.html#v:bufferGetReferenceTimestampMeta"
        })


#endif

-- method Buffer::get_size
-- method type : OrdinaryMethod
-- 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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt64)
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_get_size" gst_buffer_get_size :: 
    Ptr Buffer ->                           -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    IO Word64

-- | Gets the total size of the memory blocks in /@buffer@/.
bufferGetSize ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@buffer@/: a t'GI.Gst.Structs.Buffer.Buffer'.
    -> m Word64
    -- ^ __Returns:__ total size of the memory blocks in /@buffer@/.
bufferGetSize :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Buffer -> m Word64
bufferGetSize Buffer
buffer = 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
$ do
    Ptr Buffer
buffer' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
buffer
    Word64
result <- Ptr Buffer -> IO Word64
gst_buffer_get_size Ptr Buffer
buffer'
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    Word64 -> IO Word64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data BufferGetSizeMethodInfo
instance (signature ~ (m Word64), MonadIO m) => O.OverloadedMethod BufferGetSizeMethodInfo Buffer signature where
    overloadedMethod = bufferGetSize

instance O.OverloadedMethodInfo BufferGetSizeMethodInfo Buffer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Buffer.bufferGetSize",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Buffer.html#v:bufferGetSize"
        })


#endif

-- method Buffer::get_sizes
-- method type : OrdinaryMethod
-- 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 = "offset"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a pointer to the offset"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "maxsize"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a pointer to the maxsize"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt64)
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_get_sizes" gst_buffer_get_sizes :: 
    Ptr Buffer ->                           -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    Ptr Word64 ->                           -- offset : TBasicType TUInt64
    Ptr Word64 ->                           -- maxsize : TBasicType TUInt64
    IO Word64

-- | Gets the total size of the memory blocks in /@buffer@/.
-- 
-- When not 'P.Nothing', /@offset@/ will contain the offset of the data in the
-- first memory block in /@buffer@/ and /@maxsize@/ will contain the sum of
-- the size and /@offset@/ and the amount of extra padding on the last
-- memory block.  /@offset@/ and /@maxsize@/ can be used to resize the
-- buffer memory blocks with 'GI.Gst.Structs.Buffer.bufferResize'.
bufferGetSizes ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@buffer@/: a t'GI.Gst.Structs.Buffer.Buffer'.
    -> m ((Word64, Word64, Word64))
    -- ^ __Returns:__ total size of the memory blocks in /@buffer@/.
bufferGetSizes :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Buffer -> m (Word64, Word64, Word64)
bufferGetSizes Buffer
buffer = IO (Word64, Word64, Word64) -> m (Word64, Word64, Word64)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Word64, Word64, Word64) -> m (Word64, Word64, Word64))
-> IO (Word64, Word64, Word64) -> m (Word64, Word64, Word64)
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
    Ptr Word64
offset <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Word64
maxsize <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Word64
result <- Ptr Buffer -> Ptr Word64 -> Ptr Word64 -> IO Word64
gst_buffer_get_sizes Ptr Buffer
buffer' Ptr Word64
offset Ptr Word64
maxsize
    Word64
offset' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
offset
    Word64
maxsize' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
maxsize
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
offset
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
maxsize
    (Word64, Word64, Word64) -> IO (Word64, Word64, Word64)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64
result, Word64
offset', Word64
maxsize')

#if defined(ENABLE_OVERLOADING)
data BufferGetSizesMethodInfo
instance (signature ~ (m ((Word64, Word64, Word64))), MonadIO m) => O.OverloadedMethod BufferGetSizesMethodInfo Buffer signature where
    overloadedMethod = bufferGetSizes

instance O.OverloadedMethodInfo BufferGetSizesMethodInfo Buffer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Buffer.bufferGetSizes",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Buffer.html#v:bufferGetSizes"
        })


#endif

-- method Buffer::get_sizes_range
-- method type : OrdinaryMethod
-- 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 = "idx"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an index" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a length" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "offset"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a pointer to the offset"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "maxsize"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a pointer to the maxsize"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt64)
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_get_sizes_range" gst_buffer_get_sizes_range :: 
    Ptr Buffer ->                           -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    Word32 ->                               -- idx : TBasicType TUInt
    Int32 ->                                -- length : TBasicType TInt
    Ptr Word64 ->                           -- offset : TBasicType TUInt64
    Ptr Word64 ->                           -- maxsize : TBasicType TUInt64
    IO Word64

-- | Gets the total size of /@length@/ memory blocks stating from /@idx@/ in /@buffer@/.
-- 
-- When not 'P.Nothing', /@offset@/ will contain the offset of the data in the
-- memory block in /@buffer@/ at /@idx@/ and /@maxsize@/ will contain the sum of the size
-- and /@offset@/ and the amount of extra padding on the memory block at /@idx@/ +
-- /@length@/ -1.
-- /@offset@/ and /@maxsize@/ can be used to resize the buffer memory blocks with
-- 'GI.Gst.Structs.Buffer.bufferResizeRange'.
bufferGetSizesRange ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@buffer@/: a t'GI.Gst.Structs.Buffer.Buffer'.
    -> Word32
    -- ^ /@idx@/: an index
    -> Int32
    -- ^ /@length@/: a length
    -> m ((Word64, Word64, Word64))
    -- ^ __Returns:__ total size of /@length@/ memory blocks starting at /@idx@/ in /@buffer@/.
bufferGetSizesRange :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Buffer -> Word32 -> Int32 -> m (Word64, Word64, Word64)
bufferGetSizesRange Buffer
buffer Word32
idx Int32
length_ = IO (Word64, Word64, Word64) -> m (Word64, Word64, Word64)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Word64, Word64, Word64) -> m (Word64, Word64, Word64))
-> IO (Word64, Word64, Word64) -> m (Word64, Word64, Word64)
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
    Ptr Word64
offset <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Word64
maxsize <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Word64
result <- Ptr Buffer
-> Word32 -> Int32 -> Ptr Word64 -> Ptr Word64 -> IO Word64
gst_buffer_get_sizes_range Ptr Buffer
buffer' Word32
idx Int32
length_ Ptr Word64
offset Ptr Word64
maxsize
    Word64
offset' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
offset
    Word64
maxsize' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
maxsize
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
offset
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
maxsize
    (Word64, Word64, Word64) -> IO (Word64, Word64, Word64)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64
result, Word64
offset', Word64
maxsize')

#if defined(ENABLE_OVERLOADING)
data BufferGetSizesRangeMethodInfo
instance (signature ~ (Word32 -> Int32 -> m ((Word64, Word64, Word64))), MonadIO m) => O.OverloadedMethod BufferGetSizesRangeMethodInfo Buffer signature where
    overloadedMethod = bufferGetSizesRange

instance O.OverloadedMethodInfo BufferGetSizesRangeMethodInfo Buffer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Buffer.bufferGetSizesRange",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Buffer.html#v:bufferGetSizesRange"
        })


#endif

-- method Buffer::has_flags
-- method type : OrdinaryMethod
-- 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 = "Gst" , name = "BufferFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstBufferFlags flag to check."
--                 , 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 "gst_buffer_has_flags" gst_buffer_has_flags :: 
    Ptr Buffer ->                           -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gst", name = "BufferFlags"})
    IO CInt

-- | Gives the status of a specific flag on a buffer.
-- 
-- /Since: 1.10/
bufferHasFlags ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@buffer@/: a t'GI.Gst.Structs.Buffer.Buffer'
    -> [Gst.Flags.BufferFlags]
    -- ^ /@flags@/: the t'GI.Gst.Flags.BufferFlags' flag to check.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if all flags in /@flags@/ are found on /@buffer@/.
bufferHasFlags :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Buffer -> [BufferFlags] -> m Bool
bufferHasFlags Buffer
buffer [BufferFlags]
flags = IO Bool -> m Bool
forall a. IO a -> m a
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 Buffer
buffer' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
buffer
    let flags' :: CUInt
flags' = [BufferFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [BufferFlags]
flags
    CInt
result <- Ptr Buffer -> CUInt -> IO CInt
gst_buffer_has_flags Ptr Buffer
buffer' CUInt
flags'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BufferHasFlagsMethodInfo
instance (signature ~ ([Gst.Flags.BufferFlags] -> m Bool), MonadIO m) => O.OverloadedMethod BufferHasFlagsMethodInfo Buffer signature where
    overloadedMethod = bufferHasFlags

instance O.OverloadedMethodInfo BufferHasFlagsMethodInfo Buffer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Buffer.bufferHasFlags",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Buffer.html#v:bufferHasFlags"
        })


#endif

-- method Buffer::insert_memory
-- method type : OrdinaryMethod
-- 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 = "idx"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the index to add the memory at, or -1 to append it to the end"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mem"
--           , argType = TInterface Name { namespace = "Gst" , name = "Memory" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstMemory." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_insert_memory" gst_buffer_insert_memory :: 
    Ptr Buffer ->                           -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    Int32 ->                                -- idx : TBasicType TInt
    Ptr Gst.Memory.Memory ->                -- mem : TInterface (Name {namespace = "Gst", name = "Memory"})
    IO ()

-- | Inserts the memory block /@mem@/ into /@buffer@/ at /@idx@/. This function takes ownership
-- of /@mem@/ and thus doesn\'t increase its refcount.
-- 
-- Only 'GI.Gst.Functions.bufferGetMaxMemory' can be added to a buffer. If more memory is
-- added, existing memory blocks will automatically be merged to make room for
-- the new memory.
bufferInsertMemory ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@buffer@/: a t'GI.Gst.Structs.Buffer.Buffer'.
    -> Int32
    -- ^ /@idx@/: the index to add the memory at, or -1 to append it to the end
    -> Gst.Memory.Memory
    -- ^ /@mem@/: a t'GI.Gst.Structs.Memory.Memory'.
    -> m ()
bufferInsertMemory :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Buffer -> Int32 -> Memory -> m ()
bufferInsertMemory Buffer
buffer Int32
idx Memory
mem = 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 Buffer
buffer' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
buffer
    Ptr Memory
mem' <- Memory -> IO (Ptr Memory)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Memory
mem
    Ptr Buffer -> Int32 -> Ptr Memory -> IO ()
gst_buffer_insert_memory Ptr Buffer
buffer' Int32
idx Ptr Memory
mem'
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    Memory -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Memory
mem
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BufferInsertMemoryMethodInfo
instance (signature ~ (Int32 -> Gst.Memory.Memory -> m ()), MonadIO m) => O.OverloadedMethod BufferInsertMemoryMethodInfo Buffer signature where
    overloadedMethod = bufferInsertMemory

instance O.OverloadedMethodInfo BufferInsertMemoryMethodInfo Buffer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Buffer.bufferInsertMemory",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Buffer.html#v:bufferInsertMemory"
        })


#endif

-- method Buffer::is_all_memory_writable
-- method type : OrdinaryMethod
-- 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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_is_all_memory_writable" gst_buffer_is_all_memory_writable :: 
    Ptr Buffer ->                           -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    IO CInt

-- | Checks if all memory blocks in /@buffer@/ are writable.
-- 
-- Note that this function does not check if /@buffer@/ is writable, use
-- @/gst_buffer_is_writable()/@ to check that if needed.
-- 
-- /Since: 1.4/
bufferIsAllMemoryWritable ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@buffer@/: a t'GI.Gst.Structs.Buffer.Buffer'.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if all memory blocks in /@buffer@/ are writable
bufferIsAllMemoryWritable :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Buffer -> m Bool
bufferIsAllMemoryWritable Buffer
buffer = IO Bool -> m Bool
forall a. IO a -> m a
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 Buffer
buffer' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
buffer
    CInt
result <- Ptr Buffer -> IO CInt
gst_buffer_is_all_memory_writable Ptr Buffer
buffer'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BufferIsAllMemoryWritableMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod BufferIsAllMemoryWritableMethodInfo Buffer signature where
    overloadedMethod = bufferIsAllMemoryWritable

instance O.OverloadedMethodInfo BufferIsAllMemoryWritableMethodInfo Buffer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Buffer.bufferIsAllMemoryWritable",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Buffer.html#v:bufferIsAllMemoryWritable"
        })


#endif

-- method Buffer::is_memory_range_writable
-- method type : OrdinaryMethod
-- 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 = "idx"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an index" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a length, should not be 0"
--                 , 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 "gst_buffer_is_memory_range_writable" gst_buffer_is_memory_range_writable :: 
    Ptr Buffer ->                           -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    Word32 ->                               -- idx : TBasicType TUInt
    Int32 ->                                -- length : TBasicType TInt
    IO CInt

-- | Checks if /@length@/ memory blocks in /@buffer@/ starting from /@idx@/ are writable.
-- 
-- /@length@/ can be -1 to check all the memory blocks after /@idx@/.
-- 
-- Note that this function does not check if /@buffer@/ is writable, use
-- @/gst_buffer_is_writable()/@ to check that if needed.
-- 
-- /Since: 1.4/
bufferIsMemoryRangeWritable ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@buffer@/: a t'GI.Gst.Structs.Buffer.Buffer'.
    -> Word32
    -- ^ /@idx@/: an index
    -> Int32
    -- ^ /@length@/: a length, should not be 0
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the memory range is writable
bufferIsMemoryRangeWritable :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Buffer -> Word32 -> Int32 -> m Bool
bufferIsMemoryRangeWritable Buffer
buffer Word32
idx Int32
length_ = IO Bool -> m Bool
forall a. IO a -> m a
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 Buffer
buffer' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
buffer
    CInt
result <- Ptr Buffer -> Word32 -> Int32 -> IO CInt
gst_buffer_is_memory_range_writable Ptr Buffer
buffer' Word32
idx Int32
length_
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BufferIsMemoryRangeWritableMethodInfo
instance (signature ~ (Word32 -> Int32 -> m Bool), MonadIO m) => O.OverloadedMethod BufferIsMemoryRangeWritableMethodInfo Buffer signature where
    overloadedMethod = bufferIsMemoryRangeWritable

instance O.OverloadedMethodInfo BufferIsMemoryRangeWritableMethodInfo Buffer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Buffer.bufferIsMemoryRangeWritable",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Buffer.html#v:bufferIsMemoryRangeWritable"
        })


#endif

-- method Buffer::map
-- method type : OrdinaryMethod
-- 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 = "info"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "MapInfo" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "info about the mapping"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "MapFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "flags for the mapping"
--                 , 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 "gst_buffer_map" gst_buffer_map :: 
    Ptr Buffer ->                           -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    Ptr Gst.MapInfo.MapInfo ->              -- info : TInterface (Name {namespace = "Gst", name = "MapInfo"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gst", name = "MapFlags"})
    IO CInt

-- | Fills /@info@/ with the t'GI.Gst.Structs.MapInfo.MapInfo' of all merged memory blocks in /@buffer@/.
-- 
-- /@flags@/ describe the desired access of the memory. When /@flags@/ is
-- @/GST_MAP_WRITE/@, /@buffer@/ should be writable (as returned from
-- @/gst_buffer_is_writable()/@).
-- 
-- When /@buffer@/ is writable but the memory isn\'t, a writable copy will
-- automatically be created and returned. The readonly copy of the
-- buffer memory will then also be replaced with this writable copy.
-- 
-- The memory in /@info@/ should be unmapped with 'GI.Gst.Structs.Buffer.bufferUnmap' after
-- usage.
bufferMap ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@buffer@/: a t'GI.Gst.Structs.Buffer.Buffer'.
    -> [Gst.Flags.MapFlags]
    -- ^ /@flags@/: flags for the mapping
    -> m ((Bool, Gst.MapInfo.MapInfo))
    -- ^ __Returns:__ 'P.True' if the map succeeded and /@info@/ contains valid data.
bufferMap :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Buffer -> [MapFlags] -> m (Bool, MapInfo)
bufferMap Buffer
buffer [MapFlags]
flags = IO (Bool, MapInfo) -> m (Bool, MapInfo)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, MapInfo) -> m (Bool, MapInfo))
-> IO (Bool, MapInfo) -> m (Bool, MapInfo)
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
    Ptr MapInfo
info <- Int -> IO (Ptr MapInfo)
forall a. Int -> IO (Ptr a)
SP.callocBytes Int
104 :: IO (Ptr Gst.MapInfo.MapInfo)
    let flags' :: CUInt
flags' = [MapFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [MapFlags]
flags
    CInt
result <- Ptr Buffer -> Ptr MapInfo -> CUInt -> IO CInt
gst_buffer_map Ptr Buffer
buffer' Ptr MapInfo
info CUInt
flags'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    MapInfo
info' <- ((ManagedPtr MapInfo -> MapInfo) -> Ptr MapInfo -> IO MapInfo
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr MapInfo -> MapInfo
Gst.MapInfo.MapInfo) Ptr MapInfo
info
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    (Bool, MapInfo) -> IO (Bool, MapInfo)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', MapInfo
info')

#if defined(ENABLE_OVERLOADING)
data BufferMapMethodInfo
instance (signature ~ ([Gst.Flags.MapFlags] -> m ((Bool, Gst.MapInfo.MapInfo))), MonadIO m) => O.OverloadedMethod BufferMapMethodInfo Buffer signature where
    overloadedMethod = bufferMap

instance O.OverloadedMethodInfo BufferMapMethodInfo Buffer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Buffer.bufferMap",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Buffer.html#v:bufferMap"
        })


#endif

-- method Buffer::map_range
-- method type : OrdinaryMethod
-- 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 = "idx"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an index" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a length" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "MapInfo" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "info about the mapping"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "MapFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "flags for the mapping"
--                 , 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 "gst_buffer_map_range" gst_buffer_map_range :: 
    Ptr Buffer ->                           -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    Word32 ->                               -- idx : TBasicType TUInt
    Int32 ->                                -- length : TBasicType TInt
    Ptr Gst.MapInfo.MapInfo ->              -- info : TInterface (Name {namespace = "Gst", name = "MapInfo"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gst", name = "MapFlags"})
    IO CInt

-- | Fills /@info@/ with the t'GI.Gst.Structs.MapInfo.MapInfo' of /@length@/ merged memory blocks
-- starting at /@idx@/ in /@buffer@/. When /@length@/ is -1, all memory blocks starting
-- from /@idx@/ are merged and mapped.
-- 
-- /@flags@/ describe the desired access of the memory. When /@flags@/ is
-- @/GST_MAP_WRITE/@, /@buffer@/ should be writable (as returned from
-- @/gst_buffer_is_writable()/@).
-- 
-- When /@buffer@/ is writable but the memory isn\'t, a writable copy will
-- automatically be created and returned. The readonly copy of the buffer memory
-- will then also be replaced with this writable copy.
-- 
-- The memory in /@info@/ should be unmapped with 'GI.Gst.Structs.Buffer.bufferUnmap' after usage.
bufferMapRange ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@buffer@/: a t'GI.Gst.Structs.Buffer.Buffer'.
    -> Word32
    -- ^ /@idx@/: an index
    -> Int32
    -- ^ /@length@/: a length
    -> [Gst.Flags.MapFlags]
    -- ^ /@flags@/: flags for the mapping
    -> m ((Bool, Gst.MapInfo.MapInfo))
    -- ^ __Returns:__ 'P.True' if the map succeeded and /@info@/ contains valid
    -- data.
bufferMapRange :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Buffer -> Word32 -> Int32 -> [MapFlags] -> m (Bool, MapInfo)
bufferMapRange Buffer
buffer Word32
idx Int32
length_ [MapFlags]
flags = IO (Bool, MapInfo) -> m (Bool, MapInfo)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, MapInfo) -> m (Bool, MapInfo))
-> IO (Bool, MapInfo) -> m (Bool, MapInfo)
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
    Ptr MapInfo
info <- Int -> IO (Ptr MapInfo)
forall a. Int -> IO (Ptr a)
SP.callocBytes Int
104 :: IO (Ptr Gst.MapInfo.MapInfo)
    let flags' :: CUInt
flags' = [MapFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [MapFlags]
flags
    CInt
result <- Ptr Buffer -> Word32 -> Int32 -> Ptr MapInfo -> CUInt -> IO CInt
gst_buffer_map_range Ptr Buffer
buffer' Word32
idx Int32
length_ Ptr MapInfo
info CUInt
flags'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    MapInfo
info' <- ((ManagedPtr MapInfo -> MapInfo) -> Ptr MapInfo -> IO MapInfo
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr MapInfo -> MapInfo
Gst.MapInfo.MapInfo) Ptr MapInfo
info
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    (Bool, MapInfo) -> IO (Bool, MapInfo)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', MapInfo
info')

#if defined(ENABLE_OVERLOADING)
data BufferMapRangeMethodInfo
instance (signature ~ (Word32 -> Int32 -> [Gst.Flags.MapFlags] -> m ((Bool, Gst.MapInfo.MapInfo))), MonadIO m) => O.OverloadedMethod BufferMapRangeMethodInfo Buffer signature where
    overloadedMethod = bufferMapRange

instance O.OverloadedMethodInfo BufferMapRangeMethodInfo Buffer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Buffer.bufferMapRange",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Buffer.html#v:bufferMapRange"
        })


#endif

-- method Buffer::memcmp
-- method type : OrdinaryMethod
-- 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 = "offset"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the offset in @buffer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mem"
--           , argType = TCArray False (-1) 3 (TBasicType TUInt8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the memory to compare"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "size"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the size to compare"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "size"
--              , argType = TBasicType TUInt64
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the size to compare"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_memcmp" gst_buffer_memcmp :: 
    Ptr Buffer ->                           -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    Word64 ->                               -- offset : TBasicType TUInt64
    Ptr Word8 ->                            -- mem : TCArray False (-1) 3 (TBasicType TUInt8)
    Word64 ->                               -- size : TBasicType TUInt64
    IO Int32

-- | Compares /@size@/ bytes starting from /@offset@/ in /@buffer@/ with the memory in /@mem@/.
bufferMemcmp ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@buffer@/: a t'GI.Gst.Structs.Buffer.Buffer'.
    -> Word64
    -- ^ /@offset@/: the offset in /@buffer@/
    -> ByteString
    -- ^ /@mem@/: the memory to compare
    -> m Int32
    -- ^ __Returns:__ 0 if the memory is equal.
bufferMemcmp :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Buffer -> Word64 -> ByteString -> m Int32
bufferMemcmp Buffer
buffer Word64
offset ByteString
mem = 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
$ do
    let size :: Word64
size = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
mem
    Ptr Buffer
buffer' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
buffer
    Ptr Word8
mem' <- ByteString -> IO (Ptr Word8)
packByteString ByteString
mem
    Int32
result <- Ptr Buffer -> Word64 -> Ptr Word8 -> Word64 -> IO Int32
gst_buffer_memcmp Ptr Buffer
buffer' Word64
offset Ptr Word8
mem' Word64
size
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
mem'
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data BufferMemcmpMethodInfo
instance (signature ~ (Word64 -> ByteString -> m Int32), MonadIO m) => O.OverloadedMethod BufferMemcmpMethodInfo Buffer signature where
    overloadedMethod = bufferMemcmp

instance O.OverloadedMethodInfo BufferMemcmpMethodInfo Buffer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Buffer.bufferMemcmp",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Buffer.html#v:bufferMemcmp"
        })


#endif

-- method Buffer::memset
-- method type : OrdinaryMethod
-- 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 = "offset"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the offset in @buffer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "val"
--           , argType = TBasicType TUInt8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the value to set" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "size"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the size to set" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt64)
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_memset" gst_buffer_memset :: 
    Ptr Buffer ->                           -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    Word64 ->                               -- offset : TBasicType TUInt64
    Word8 ->                                -- val : TBasicType TUInt8
    Word64 ->                               -- size : TBasicType TUInt64
    IO Word64

-- | Fills /@buf@/ with /@size@/ bytes with /@val@/ starting from /@offset@/.
bufferMemset ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@buffer@/: a t'GI.Gst.Structs.Buffer.Buffer'.
    -> Word64
    -- ^ /@offset@/: the offset in /@buffer@/
    -> Word8
    -- ^ /@val@/: the value to set
    -> Word64
    -- ^ /@size@/: the size to set
    -> m Word64
    -- ^ __Returns:__ The amount of bytes filled. This value can be lower than /@size@/
    --    when /@buffer@/ did not contain enough data.
bufferMemset :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Buffer -> Word64 -> Word8 -> Word64 -> m Word64
bufferMemset Buffer
buffer Word64
offset Word8
val Word64
size = 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
$ do
    Ptr Buffer
buffer' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
buffer
    Word64
result <- Ptr Buffer -> Word64 -> Word8 -> Word64 -> IO Word64
gst_buffer_memset Ptr Buffer
buffer' Word64
offset Word8
val Word64
size
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    Word64 -> IO Word64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data BufferMemsetMethodInfo
instance (signature ~ (Word64 -> Word8 -> Word64 -> m Word64), MonadIO m) => O.OverloadedMethod BufferMemsetMethodInfo Buffer signature where
    overloadedMethod = bufferMemset

instance O.OverloadedMethodInfo BufferMemsetMethodInfo Buffer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Buffer.bufferMemset",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Buffer.html#v:bufferMemset"
        })


#endif

-- method Buffer::n_memory
-- method type : OrdinaryMethod
-- 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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_n_memory" gst_buffer_n_memory :: 
    Ptr Buffer ->                           -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    IO Word32

-- | Gets the amount of memory blocks that this buffer has. This amount is never
-- larger than what 'GI.Gst.Functions.bufferGetMaxMemory' returns.
bufferNMemory ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@buffer@/: a t'GI.Gst.Structs.Buffer.Buffer'.
    -> m Word32
    -- ^ __Returns:__ the number of memory blocks this buffer is made of.
bufferNMemory :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Buffer -> m Word32
bufferNMemory Buffer
buffer = 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
$ do
    Ptr Buffer
buffer' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
buffer
    Word32
result <- Ptr Buffer -> IO Word32
gst_buffer_n_memory Ptr Buffer
buffer'
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data BufferNMemoryMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.OverloadedMethod BufferNMemoryMethodInfo Buffer signature where
    overloadedMethod = bufferNMemory

instance O.OverloadedMethodInfo BufferNMemoryMethodInfo Buffer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Buffer.bufferNMemory",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Buffer.html#v:bufferNMemory"
        })


#endif

-- method Buffer::peek_memory
-- method type : OrdinaryMethod
-- 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 = "idx"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an index" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Memory" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_peek_memory" gst_buffer_peek_memory :: 
    Ptr Buffer ->                           -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    Word32 ->                               -- idx : TBasicType TUInt
    IO (Ptr Gst.Memory.Memory)

-- | Gets the memory block at /@idx@/ in /@buffer@/. The memory block stays valid until
-- the memory block in /@buffer@/ is removed, replaced or merged, typically with
-- any call that modifies the memory in /@buffer@/.
bufferPeekMemory ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@buffer@/: a t'GI.Gst.Structs.Buffer.Buffer'.
    -> Word32
    -- ^ /@idx@/: an index
    -> m (Maybe Gst.Memory.Memory)
    -- ^ __Returns:__ the t'GI.Gst.Structs.Memory.Memory' at /@idx@/.
bufferPeekMemory :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Buffer -> Word32 -> m (Maybe Memory)
bufferPeekMemory Buffer
buffer Word32
idx = IO (Maybe Memory) -> m (Maybe Memory)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Memory) -> m (Maybe Memory))
-> IO (Maybe Memory) -> m (Maybe Memory)
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
    Ptr Memory
result <- Ptr Buffer -> Word32 -> IO (Ptr Memory)
gst_buffer_peek_memory Ptr Buffer
buffer' Word32
idx
    Maybe Memory
maybeResult <- Ptr Memory -> (Ptr Memory -> IO Memory) -> IO (Maybe Memory)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Memory
result ((Ptr Memory -> IO Memory) -> IO (Maybe Memory))
-> (Ptr Memory -> IO Memory) -> IO (Maybe Memory)
forall a b. (a -> b) -> a -> b
$ \Ptr Memory
result' -> do
        Memory
result'' <- ((ManagedPtr Memory -> Memory) -> Ptr Memory -> IO Memory
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Memory -> Memory
Gst.Memory.Memory) Ptr Memory
result'
        Memory -> IO Memory
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Memory
result''
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    Maybe Memory -> IO (Maybe Memory)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Memory
maybeResult

#if defined(ENABLE_OVERLOADING)
data BufferPeekMemoryMethodInfo
instance (signature ~ (Word32 -> m (Maybe Gst.Memory.Memory)), MonadIO m) => O.OverloadedMethod BufferPeekMemoryMethodInfo Buffer signature where
    overloadedMethod = bufferPeekMemory

instance O.OverloadedMethodInfo BufferPeekMemoryMethodInfo Buffer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Buffer.bufferPeekMemory",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Buffer.html#v:bufferPeekMemory"
        })


#endif

-- method Buffer::prepend_memory
-- method type : OrdinaryMethod
-- 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 = "mem"
--           , argType = TInterface Name { namespace = "Gst" , name = "Memory" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstMemory." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_prepend_memory" gst_buffer_prepend_memory :: 
    Ptr Buffer ->                           -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    Ptr Gst.Memory.Memory ->                -- mem : TInterface (Name {namespace = "Gst", name = "Memory"})
    IO ()

-- | Prepends the memory block /@mem@/ to /@buffer@/. This function takes
-- ownership of /@mem@/ and thus doesn\'t increase its refcount.
-- 
-- This function is identical to 'GI.Gst.Structs.Buffer.bufferInsertMemory' with an index of 0.
-- See 'GI.Gst.Structs.Buffer.bufferInsertMemory' for more details.
bufferPrependMemory ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@buffer@/: a t'GI.Gst.Structs.Buffer.Buffer'.
    -> Gst.Memory.Memory
    -- ^ /@mem@/: a t'GI.Gst.Structs.Memory.Memory'.
    -> m ()
bufferPrependMemory :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Buffer -> Memory -> m ()
bufferPrependMemory Buffer
buffer Memory
mem = 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 Buffer
buffer' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
buffer
    Ptr Memory
mem' <- Memory -> IO (Ptr Memory)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Memory
mem
    Ptr Buffer -> Ptr Memory -> IO ()
gst_buffer_prepend_memory Ptr Buffer
buffer' Ptr Memory
mem'
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    Memory -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Memory
mem
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BufferPrependMemoryMethodInfo
instance (signature ~ (Gst.Memory.Memory -> m ()), MonadIO m) => O.OverloadedMethod BufferPrependMemoryMethodInfo Buffer signature where
    overloadedMethod = bufferPrependMemory

instance O.OverloadedMethodInfo BufferPrependMemoryMethodInfo Buffer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Buffer.bufferPrependMemory",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Buffer.html#v:bufferPrependMemory"
        })


#endif

-- method Buffer::remove_all_memory
-- method type : OrdinaryMethod
-- 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
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_remove_all_memory" gst_buffer_remove_all_memory :: 
    Ptr Buffer ->                           -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    IO ()

-- | Removes all the memory blocks in /@buffer@/.
bufferRemoveAllMemory ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@buffer@/: a t'GI.Gst.Structs.Buffer.Buffer'.
    -> m ()
bufferRemoveAllMemory :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Buffer -> m ()
bufferRemoveAllMemory Buffer
buffer = 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 Buffer
buffer' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
buffer
    Ptr Buffer -> IO ()
gst_buffer_remove_all_memory Ptr Buffer
buffer'
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BufferRemoveAllMemoryMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod BufferRemoveAllMemoryMethodInfo Buffer signature where
    overloadedMethod = bufferRemoveAllMemory

instance O.OverloadedMethodInfo BufferRemoveAllMemoryMethodInfo Buffer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Buffer.bufferRemoveAllMemory",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Buffer.html#v:bufferRemoveAllMemory"
        })


#endif

-- method Buffer::remove_memory
-- method type : OrdinaryMethod
-- 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 = "idx"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an index" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_remove_memory" gst_buffer_remove_memory :: 
    Ptr Buffer ->                           -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    Word32 ->                               -- idx : TBasicType TUInt
    IO ()

-- | Removes the memory block in /@b@/ at index /@i@/.
bufferRemoveMemory ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@buffer@/: a t'GI.Gst.Structs.Buffer.Buffer'.
    -> Word32
    -- ^ /@idx@/: an index
    -> m ()
bufferRemoveMemory :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Buffer -> Word32 -> m ()
bufferRemoveMemory Buffer
buffer Word32
idx = 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 Buffer
buffer' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
buffer
    Ptr Buffer -> Word32 -> IO ()
gst_buffer_remove_memory Ptr Buffer
buffer' Word32
idx
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BufferRemoveMemoryMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m) => O.OverloadedMethod BufferRemoveMemoryMethodInfo Buffer signature where
    overloadedMethod = bufferRemoveMemory

instance O.OverloadedMethodInfo BufferRemoveMemoryMethodInfo Buffer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Buffer.bufferRemoveMemory",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Buffer.html#v:bufferRemoveMemory"
        })


#endif

-- method Buffer::remove_memory_range
-- method type : OrdinaryMethod
-- 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 = "idx"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an index" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a length" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_remove_memory_range" gst_buffer_remove_memory_range :: 
    Ptr Buffer ->                           -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    Word32 ->                               -- idx : TBasicType TUInt
    Int32 ->                                -- length : TBasicType TInt
    IO ()

-- | Removes /@length@/ memory blocks in /@buffer@/ starting from /@idx@/.
-- 
-- /@length@/ can be -1, in which case all memory starting from /@idx@/ is removed.
bufferRemoveMemoryRange ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@buffer@/: a t'GI.Gst.Structs.Buffer.Buffer'.
    -> Word32
    -- ^ /@idx@/: an index
    -> Int32
    -- ^ /@length@/: a length
    -> m ()
bufferRemoveMemoryRange :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Buffer -> Word32 -> Int32 -> m ()
bufferRemoveMemoryRange Buffer
buffer Word32
idx Int32
length_ = 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 Buffer
buffer' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
buffer
    Ptr Buffer -> Word32 -> Int32 -> IO ()
gst_buffer_remove_memory_range Ptr Buffer
buffer' Word32
idx Int32
length_
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BufferRemoveMemoryRangeMethodInfo
instance (signature ~ (Word32 -> Int32 -> m ()), MonadIO m) => O.OverloadedMethod BufferRemoveMemoryRangeMethodInfo Buffer signature where
    overloadedMethod = bufferRemoveMemoryRange

instance O.OverloadedMethodInfo BufferRemoveMemoryRangeMethodInfo Buffer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Buffer.bufferRemoveMemoryRange",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Buffer.html#v:bufferRemoveMemoryRange"
        })


#endif

-- method Buffer::remove_meta
-- method type : OrdinaryMethod
-- 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 = "meta"
--           , argType = TInterface Name { namespace = "Gst" , name = "Meta" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstMeta" , 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 "gst_buffer_remove_meta" gst_buffer_remove_meta :: 
    Ptr Buffer ->                           -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    Ptr Gst.Meta.Meta ->                    -- meta : TInterface (Name {namespace = "Gst", name = "Meta"})
    IO CInt

-- | Removes the metadata for /@meta@/ on /@buffer@/.
bufferRemoveMeta ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@buffer@/: a t'GI.Gst.Structs.Buffer.Buffer'
    -> Gst.Meta.Meta
    -- ^ /@meta@/: a t'GI.Gst.Structs.Meta.Meta'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the metadata existed and was removed, 'P.False' if no such
    -- metadata was on /@buffer@/.
bufferRemoveMeta :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Buffer -> Meta -> m Bool
bufferRemoveMeta Buffer
buffer Meta
meta = IO Bool -> m Bool
forall a. IO a -> m a
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 Buffer
buffer' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
buffer
    Ptr Meta
meta' <- Meta -> IO (Ptr Meta)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Meta
meta
    CInt
result <- Ptr Buffer -> Ptr Meta -> IO CInt
gst_buffer_remove_meta Ptr Buffer
buffer' Ptr Meta
meta'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    Meta -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Meta
meta
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BufferRemoveMetaMethodInfo
instance (signature ~ (Gst.Meta.Meta -> m Bool), MonadIO m) => O.OverloadedMethod BufferRemoveMetaMethodInfo Buffer signature where
    overloadedMethod = bufferRemoveMeta

instance O.OverloadedMethodInfo BufferRemoveMetaMethodInfo Buffer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Buffer.bufferRemoveMeta",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Buffer.html#v:bufferRemoveMeta"
        })


#endif

-- method Buffer::replace_all_memory
-- method type : OrdinaryMethod
-- 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 = "mem"
--           , argType = TInterface Name { namespace = "Gst" , name = "Memory" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstMemory" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_replace_all_memory" gst_buffer_replace_all_memory :: 
    Ptr Buffer ->                           -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    Ptr Gst.Memory.Memory ->                -- mem : TInterface (Name {namespace = "Gst", name = "Memory"})
    IO ()

-- | Replaces all memory in /@buffer@/ with /@mem@/.
bufferReplaceAllMemory ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@buffer@/: a t'GI.Gst.Structs.Buffer.Buffer'.
    -> Gst.Memory.Memory
    -- ^ /@mem@/: a t'GI.Gst.Structs.Memory.Memory'
    -> m ()
bufferReplaceAllMemory :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Buffer -> Memory -> m ()
bufferReplaceAllMemory Buffer
buffer Memory
mem = 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 Buffer
buffer' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
buffer
    Ptr Memory
mem' <- Memory -> IO (Ptr Memory)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Memory
mem
    Ptr Buffer -> Ptr Memory -> IO ()
gst_buffer_replace_all_memory Ptr Buffer
buffer' Ptr Memory
mem'
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    Memory -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Memory
mem
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BufferReplaceAllMemoryMethodInfo
instance (signature ~ (Gst.Memory.Memory -> m ()), MonadIO m) => O.OverloadedMethod BufferReplaceAllMemoryMethodInfo Buffer signature where
    overloadedMethod = bufferReplaceAllMemory

instance O.OverloadedMethodInfo BufferReplaceAllMemoryMethodInfo Buffer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Buffer.bufferReplaceAllMemory",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Buffer.html#v:bufferReplaceAllMemory"
        })


#endif

-- method Buffer::replace_memory
-- method type : OrdinaryMethod
-- 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 = "idx"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an index" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mem"
--           , argType = TInterface Name { namespace = "Gst" , name = "Memory" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstMemory" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_replace_memory" gst_buffer_replace_memory :: 
    Ptr Buffer ->                           -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    Word32 ->                               -- idx : TBasicType TUInt
    Ptr Gst.Memory.Memory ->                -- mem : TInterface (Name {namespace = "Gst", name = "Memory"})
    IO ()

-- | Replaces the memory block at index /@idx@/ in /@buffer@/ with /@mem@/.
bufferReplaceMemory ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@buffer@/: a t'GI.Gst.Structs.Buffer.Buffer'.
    -> Word32
    -- ^ /@idx@/: an index
    -> Gst.Memory.Memory
    -- ^ /@mem@/: a t'GI.Gst.Structs.Memory.Memory'
    -> m ()
bufferReplaceMemory :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Buffer -> Word32 -> Memory -> m ()
bufferReplaceMemory Buffer
buffer Word32
idx Memory
mem = 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 Buffer
buffer' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
buffer
    Ptr Memory
mem' <- Memory -> IO (Ptr Memory)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Memory
mem
    Ptr Buffer -> Word32 -> Ptr Memory -> IO ()
gst_buffer_replace_memory Ptr Buffer
buffer' Word32
idx Ptr Memory
mem'
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    Memory -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Memory
mem
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BufferReplaceMemoryMethodInfo
instance (signature ~ (Word32 -> Gst.Memory.Memory -> m ()), MonadIO m) => O.OverloadedMethod BufferReplaceMemoryMethodInfo Buffer signature where
    overloadedMethod = bufferReplaceMemory

instance O.OverloadedMethodInfo BufferReplaceMemoryMethodInfo Buffer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Buffer.bufferReplaceMemory",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Buffer.html#v:bufferReplaceMemory"
        })


#endif

-- method Buffer::replace_memory_range
-- method type : OrdinaryMethod
-- 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 = "idx"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an index" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a length, should not be 0"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mem"
--           , argType = TInterface Name { namespace = "Gst" , name = "Memory" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstMemory" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_replace_memory_range" gst_buffer_replace_memory_range :: 
    Ptr Buffer ->                           -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    Word32 ->                               -- idx : TBasicType TUInt
    Int32 ->                                -- length : TBasicType TInt
    Ptr Gst.Memory.Memory ->                -- mem : TInterface (Name {namespace = "Gst", name = "Memory"})
    IO ()

-- | Replaces /@length@/ memory blocks in /@buffer@/ starting at /@idx@/ with /@mem@/.
-- 
-- If /@length@/ is -1, all memory starting from /@idx@/ will be removed and
-- replaced with /@mem@/.
-- 
-- /@buffer@/ should be writable.
bufferReplaceMemoryRange ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@buffer@/: a t'GI.Gst.Structs.Buffer.Buffer'.
    -> Word32
    -- ^ /@idx@/: an index
    -> Int32
    -- ^ /@length@/: a length, should not be 0
    -> Gst.Memory.Memory
    -- ^ /@mem@/: a t'GI.Gst.Structs.Memory.Memory'
    -> m ()
bufferReplaceMemoryRange :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Buffer -> Word32 -> Int32 -> Memory -> m ()
bufferReplaceMemoryRange Buffer
buffer Word32
idx Int32
length_ Memory
mem = 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 Buffer
buffer' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
buffer
    Ptr Memory
mem' <- Memory -> IO (Ptr Memory)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Memory
mem
    Ptr Buffer -> Word32 -> Int32 -> Ptr Memory -> IO ()
gst_buffer_replace_memory_range Ptr Buffer
buffer' Word32
idx Int32
length_ Ptr Memory
mem'
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    Memory -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Memory
mem
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BufferReplaceMemoryRangeMethodInfo
instance (signature ~ (Word32 -> Int32 -> Gst.Memory.Memory -> m ()), MonadIO m) => O.OverloadedMethod BufferReplaceMemoryRangeMethodInfo Buffer signature where
    overloadedMethod = bufferReplaceMemoryRange

instance O.OverloadedMethodInfo BufferReplaceMemoryRangeMethodInfo Buffer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Buffer.bufferReplaceMemoryRange",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Buffer.html#v:bufferReplaceMemoryRange"
        })


#endif

-- method Buffer::resize
-- method type : OrdinaryMethod
-- 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 = "offset"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the offset adjustment"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "size"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new size or -1 to just adjust the offset"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_resize" gst_buffer_resize :: 
    Ptr Buffer ->                           -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    Int64 ->                                -- offset : TBasicType TInt64
    Int64 ->                                -- size : TBasicType TInt64
    IO ()

-- | Sets the offset and total size of the memory blocks in /@buffer@/.
bufferResize ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@buffer@/: a t'GI.Gst.Structs.Buffer.Buffer'.
    -> Int64
    -- ^ /@offset@/: the offset adjustment
    -> Int64
    -- ^ /@size@/: the new size or -1 to just adjust the offset
    -> m ()
bufferResize :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Buffer -> Int64 -> Int64 -> m ()
bufferResize Buffer
buffer Int64
offset Int64
size = 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 Buffer
buffer' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
buffer
    Ptr Buffer -> Int64 -> Int64 -> IO ()
gst_buffer_resize Ptr Buffer
buffer' Int64
offset Int64
size
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BufferResizeMethodInfo
instance (signature ~ (Int64 -> Int64 -> m ()), MonadIO m) => O.OverloadedMethod BufferResizeMethodInfo Buffer signature where
    overloadedMethod = bufferResize

instance O.OverloadedMethodInfo BufferResizeMethodInfo Buffer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Buffer.bufferResize",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Buffer.html#v:bufferResize"
        })


#endif

-- method Buffer::resize_range
-- method type : OrdinaryMethod
-- 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 = "idx"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an index" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a length" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "offset"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the offset adjustment"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "size"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new size or -1 to just adjust the offset"
--                 , 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 "gst_buffer_resize_range" gst_buffer_resize_range :: 
    Ptr Buffer ->                           -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    Word32 ->                               -- idx : TBasicType TUInt
    Int32 ->                                -- length : TBasicType TInt
    Int64 ->                                -- offset : TBasicType TInt64
    Int64 ->                                -- size : TBasicType TInt64
    IO CInt

-- | Sets the total size of the /@length@/ memory blocks starting at /@idx@/ in
-- /@buffer@/
bufferResizeRange ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@buffer@/: a t'GI.Gst.Structs.Buffer.Buffer'.
    -> Word32
    -- ^ /@idx@/: an index
    -> Int32
    -- ^ /@length@/: a length
    -> Int64
    -- ^ /@offset@/: the offset adjustment
    -> Int64
    -- ^ /@size@/: the new size or -1 to just adjust the offset
    -> m Bool
    -- ^ __Returns:__ 'P.True' if resizing succeeded, 'P.False' otherwise.
bufferResizeRange :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Buffer -> Word32 -> Int32 -> Int64 -> Int64 -> m Bool
bufferResizeRange Buffer
buffer Word32
idx Int32
length_ Int64
offset Int64
size = IO Bool -> m Bool
forall a. IO a -> m a
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 Buffer
buffer' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
buffer
    CInt
result <- Ptr Buffer -> Word32 -> Int32 -> Int64 -> Int64 -> IO CInt
gst_buffer_resize_range Ptr Buffer
buffer' Word32
idx Int32
length_ Int64
offset Int64
size
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BufferResizeRangeMethodInfo
instance (signature ~ (Word32 -> Int32 -> Int64 -> Int64 -> m Bool), MonadIO m) => O.OverloadedMethod BufferResizeRangeMethodInfo Buffer signature where
    overloadedMethod = bufferResizeRange

instance O.OverloadedMethodInfo BufferResizeRangeMethodInfo Buffer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Buffer.bufferResizeRange",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Buffer.html#v:bufferResizeRange"
        })


#endif

-- method Buffer::set_flags
-- method type : OrdinaryMethod
-- 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 = "Gst" , name = "BufferFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstBufferFlags to set."
--                 , 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 "gst_buffer_set_flags" gst_buffer_set_flags :: 
    Ptr Buffer ->                           -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gst", name = "BufferFlags"})
    IO CInt

-- | Sets one or more buffer flags on a buffer.
-- 
-- /Since: 1.10/
bufferSetFlags ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@buffer@/: a t'GI.Gst.Structs.Buffer.Buffer'
    -> [Gst.Flags.BufferFlags]
    -- ^ /@flags@/: the t'GI.Gst.Flags.BufferFlags' to set.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@flags@/ were successfully set on buffer.
bufferSetFlags :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Buffer -> [BufferFlags] -> m Bool
bufferSetFlags Buffer
buffer [BufferFlags]
flags = IO Bool -> m Bool
forall a. IO a -> m a
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 Buffer
buffer' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
buffer
    let flags' :: CUInt
flags' = [BufferFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [BufferFlags]
flags
    CInt
result <- Ptr Buffer -> CUInt -> IO CInt
gst_buffer_set_flags Ptr Buffer
buffer' CUInt
flags'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BufferSetFlagsMethodInfo
instance (signature ~ ([Gst.Flags.BufferFlags] -> m Bool), MonadIO m) => O.OverloadedMethod BufferSetFlagsMethodInfo Buffer signature where
    overloadedMethod = bufferSetFlags

instance O.OverloadedMethodInfo BufferSetFlagsMethodInfo Buffer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Buffer.bufferSetFlags",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Buffer.html#v:bufferSetFlags"
        })


#endif

-- method Buffer::set_size
-- method type : OrdinaryMethod
-- 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 = "size"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new size" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_set_size" gst_buffer_set_size :: 
    Ptr Buffer ->                           -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    Int64 ->                                -- size : TBasicType TInt64
    IO ()

-- | Sets the total size of the memory blocks in /@buffer@/.
bufferSetSize ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@buffer@/: a t'GI.Gst.Structs.Buffer.Buffer'.
    -> Int64
    -- ^ /@size@/: the new size
    -> m ()
bufferSetSize :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Buffer -> Int64 -> m ()
bufferSetSize Buffer
buffer Int64
size = 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 Buffer
buffer' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
buffer
    Ptr Buffer -> Int64 -> IO ()
gst_buffer_set_size Ptr Buffer
buffer' Int64
size
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BufferSetSizeMethodInfo
instance (signature ~ (Int64 -> m ()), MonadIO m) => O.OverloadedMethod BufferSetSizeMethodInfo Buffer signature where
    overloadedMethod = bufferSetSize

instance O.OverloadedMethodInfo BufferSetSizeMethodInfo Buffer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Buffer.bufferSetSize",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Buffer.html#v:bufferSetSize"
        })


#endif

-- method Buffer::unmap
-- method type : OrdinaryMethod
-- 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 = "info"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "MapInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstMapInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Releases the memory previously mapped with 'GI.Gst.Structs.Buffer.bufferMap'.
bufferUnmap ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@buffer@/: a t'GI.Gst.Structs.Buffer.Buffer'.
    -> Gst.MapInfo.MapInfo
    -- ^ /@info@/: a t'GI.Gst.Structs.MapInfo.MapInfo'
    -> m ()
bufferUnmap :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Buffer -> MapInfo -> m ()
bufferUnmap Buffer
buffer MapInfo
info = 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 Buffer
buffer' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
buffer
    Ptr MapInfo
info' <- MapInfo -> IO (Ptr MapInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MapInfo
info
    Ptr Buffer -> Ptr MapInfo -> IO ()
gst_buffer_unmap Ptr Buffer
buffer' Ptr MapInfo
info'
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    MapInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MapInfo
info
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BufferUnmapMethodInfo
instance (signature ~ (Gst.MapInfo.MapInfo -> m ()), MonadIO m) => O.OverloadedMethod BufferUnmapMethodInfo Buffer signature where
    overloadedMethod = bufferUnmap

instance O.OverloadedMethodInfo BufferUnmapMethodInfo Buffer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Buffer.bufferUnmap",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Buffer.html#v:bufferUnmap"
        })


#endif

-- method Buffer::unset_flags
-- method type : OrdinaryMethod
-- 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 = "Gst" , name = "BufferFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstBufferFlags to clear"
--                 , 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 "gst_buffer_unset_flags" gst_buffer_unset_flags :: 
    Ptr Buffer ->                           -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gst", name = "BufferFlags"})
    IO CInt

-- | Clears one or more buffer flags.
-- 
-- /Since: 1.10/
bufferUnsetFlags ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@buffer@/: a t'GI.Gst.Structs.Buffer.Buffer'
    -> [Gst.Flags.BufferFlags]
    -- ^ /@flags@/: the t'GI.Gst.Flags.BufferFlags' to clear
    -> m Bool
    -- ^ __Returns:__ true if /@flags@/ is successfully cleared from buffer.
bufferUnsetFlags :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Buffer -> [BufferFlags] -> m Bool
bufferUnsetFlags Buffer
buffer [BufferFlags]
flags = IO Bool -> m Bool
forall a. IO a -> m a
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 Buffer
buffer' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
buffer
    let flags' :: CUInt
flags' = [BufferFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [BufferFlags]
flags
    CInt
result <- Ptr Buffer -> CUInt -> IO CInt
gst_buffer_unset_flags Ptr Buffer
buffer' CUInt
flags'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BufferUnsetFlagsMethodInfo
instance (signature ~ ([Gst.Flags.BufferFlags] -> m Bool), MonadIO m) => O.OverloadedMethod BufferUnsetFlagsMethodInfo Buffer signature where
    overloadedMethod = bufferUnsetFlags

instance O.OverloadedMethodInfo BufferUnsetFlagsMethodInfo Buffer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Buffer.bufferUnsetFlags",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Buffer.html#v:bufferUnsetFlags"
        })


#endif

-- method Buffer::get_max_memory
-- method type : MemberFunction
-- Args: []
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_get_max_memory" gst_buffer_get_max_memory :: 
    IO Word32

-- | Gets the maximum amount of memory blocks that a buffer can hold. This is a
-- compile time constant that can be queried with the function.
-- 
-- When more memory blocks are added, existing memory blocks will be merged
-- together to make room for the new block.
-- 
-- /Since: 1.2/
bufferGetMaxMemory ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Word32
    -- ^ __Returns:__ the maximum amount of memory blocks that a buffer can hold.
bufferGetMaxMemory :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Word32
bufferGetMaxMemory  = 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
$ do
    Word32
result <- IO Word32
gst_buffer_get_max_memory
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveBufferMethod (t :: Symbol) (o :: *) :: * where
    ResolveBufferMethod "addCustomMeta" o = BufferAddCustomMetaMethodInfo
    ResolveBufferMethod "addMeta" o = BufferAddMetaMethodInfo
    ResolveBufferMethod "addParentBufferMeta" o = BufferAddParentBufferMetaMethodInfo
    ResolveBufferMethod "addProtectionMeta" o = BufferAddProtectionMetaMethodInfo
    ResolveBufferMethod "addReferenceTimestampMeta" o = BufferAddReferenceTimestampMetaMethodInfo
    ResolveBufferMethod "append" o = BufferAppendMethodInfo
    ResolveBufferMethod "appendMemory" o = BufferAppendMemoryMethodInfo
    ResolveBufferMethod "appendRegion" o = BufferAppendRegionMethodInfo
    ResolveBufferMethod "copyDeep" o = BufferCopyDeepMethodInfo
    ResolveBufferMethod "copyInto" o = BufferCopyIntoMethodInfo
    ResolveBufferMethod "copyRegion" o = BufferCopyRegionMethodInfo
    ResolveBufferMethod "extract" o = BufferExtractMethodInfo
    ResolveBufferMethod "extractDup" o = BufferExtractDupMethodInfo
    ResolveBufferMethod "fill" o = BufferFillMethodInfo
    ResolveBufferMethod "findMemory" o = BufferFindMemoryMethodInfo
    ResolveBufferMethod "foreachMeta" o = BufferForeachMetaMethodInfo
    ResolveBufferMethod "hasFlags" o = BufferHasFlagsMethodInfo
    ResolveBufferMethod "insertMemory" o = BufferInsertMemoryMethodInfo
    ResolveBufferMethod "isAllMemoryWritable" o = BufferIsAllMemoryWritableMethodInfo
    ResolveBufferMethod "isMemoryRangeWritable" o = BufferIsMemoryRangeWritableMethodInfo
    ResolveBufferMethod "map" o = BufferMapMethodInfo
    ResolveBufferMethod "mapRange" o = BufferMapRangeMethodInfo
    ResolveBufferMethod "memcmp" o = BufferMemcmpMethodInfo
    ResolveBufferMethod "memset" o = BufferMemsetMethodInfo
    ResolveBufferMethod "nMemory" o = BufferNMemoryMethodInfo
    ResolveBufferMethod "peekMemory" o = BufferPeekMemoryMethodInfo
    ResolveBufferMethod "prependMemory" o = BufferPrependMemoryMethodInfo
    ResolveBufferMethod "removeAllMemory" o = BufferRemoveAllMemoryMethodInfo
    ResolveBufferMethod "removeMemory" o = BufferRemoveMemoryMethodInfo
    ResolveBufferMethod "removeMemoryRange" o = BufferRemoveMemoryRangeMethodInfo
    ResolveBufferMethod "removeMeta" o = BufferRemoveMetaMethodInfo
    ResolveBufferMethod "replaceAllMemory" o = BufferReplaceAllMemoryMethodInfo
    ResolveBufferMethod "replaceMemory" o = BufferReplaceMemoryMethodInfo
    ResolveBufferMethod "replaceMemoryRange" o = BufferReplaceMemoryRangeMethodInfo
    ResolveBufferMethod "resize" o = BufferResizeMethodInfo
    ResolveBufferMethod "resizeRange" o = BufferResizeRangeMethodInfo
    ResolveBufferMethod "unmap" o = BufferUnmapMethodInfo
    ResolveBufferMethod "unsetFlags" o = BufferUnsetFlagsMethodInfo
    ResolveBufferMethod "getAllMemory" o = BufferGetAllMemoryMethodInfo
    ResolveBufferMethod "getCustomMeta" o = BufferGetCustomMetaMethodInfo
    ResolveBufferMethod "getFlags" o = BufferGetFlagsMethodInfo
    ResolveBufferMethod "getMemory" o = BufferGetMemoryMethodInfo
    ResolveBufferMethod "getMemoryRange" o = BufferGetMemoryRangeMethodInfo
    ResolveBufferMethod "getMeta" o = BufferGetMetaMethodInfo
    ResolveBufferMethod "getNMeta" o = BufferGetNMetaMethodInfo
    ResolveBufferMethod "getReferenceTimestampMeta" o = BufferGetReferenceTimestampMetaMethodInfo
    ResolveBufferMethod "getSize" o = BufferGetSizeMethodInfo
    ResolveBufferMethod "getSizes" o = BufferGetSizesMethodInfo
    ResolveBufferMethod "getSizesRange" o = BufferGetSizesRangeMethodInfo
    ResolveBufferMethod "setFlags" o = BufferSetFlagsMethodInfo
    ResolveBufferMethod "setSize" o = BufferSetSizeMethodInfo
    ResolveBufferMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveBufferMethod t Buffer, O.OverloadedMethod info Buffer p) => OL.IsLabel t (Buffer -> 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 ~ ResolveBufferMethod t Buffer, O.OverloadedMethod info Buffer p, R.HasField t Buffer p) => R.HasField t Buffer p where
    getField = O.overloadedMethod @info

#endif

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

#endif