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

GstMemory is a lightweight refcounted object that wraps a region of memory.
They are typically used to manage the data of a 'GI.Gst.Structs.Buffer.Buffer'.

A GstMemory object has an allocated region of memory of maxsize. The maximum
size does not change during the lifetime of the memory object. The memory
also has an offset and size property that specifies the valid range of memory
in the allocated region.

Memory is usually created by allocators with a 'GI.Gst.Objects.Allocator.allocatorAlloc'
method call. When 'Nothing' is used as the allocator, the default allocator will
be used.

New allocators can be registered with 'GI.Gst.Objects.Allocator.allocatorRegister'.
Allocators are identified by name and can be retrieved with
'GI.Gst.Objects.Allocator.allocatorFind'. 'GI.Gst.Objects.Allocator.allocatorSetDefault' can be used to change the
default allocator.

New memory can be created with 'GI.Gst.Structs.Memory.memoryNewWrapped' that wraps the memory
allocated elsewhere.

Refcounting of the memory block is performed with @/gst_memory_ref()/@ and
@/gst_memory_unref()/@.

The size of the memory can be retrieved and changed with
'GI.Gst.Structs.Memory.memoryGetSizes' and 'GI.Gst.Structs.Memory.memoryResize' respectively.

Getting access to the data of the memory is performed with 'GI.Gst.Structs.Memory.memoryMap'.
The call will return a pointer to offset bytes into the region of memory.
After the memory access is completed, 'GI.Gst.Structs.Memory.memoryUnmap' should be called.

Memory can be copied with 'GI.Gst.Structs.Memory.memoryCopy', which will return a writable
copy. 'GI.Gst.Structs.Memory.memoryShare' will create a new memory block that shares the
memory with an existing memory block at a custom offset and with a custom
size.

Memory can be efficiently merged when 'GI.Gst.Structs.Memory.memoryIsSpan' returns 'True'.
-}

module GI.Gst.Structs.Memory
    ( 

-- * Exported types
    Memory(..)                              ,
    newZeroMemory                           ,
    noMemory                                ,


 -- * Methods
-- ** copy #method:copy#
    MemoryCopyMethodInfo                    ,
    memoryCopy                              ,


-- ** getSizes #method:getSizes#
    MemoryGetSizesMethodInfo                ,
    memoryGetSizes                          ,


-- ** isSpan #method:isSpan#
    MemoryIsSpanMethodInfo                  ,
    memoryIsSpan                            ,


-- ** isType #method:isType#
    MemoryIsTypeMethodInfo                  ,
    memoryIsType                            ,


-- ** makeMapped #method:makeMapped#
    MemoryMakeMappedMethodInfo              ,
    memoryMakeMapped                        ,


-- ** map #method:map#
    MemoryMapMethodInfo                     ,
    memoryMap                               ,


-- ** newWrapped #method:newWrapped#
    memoryNewWrapped                        ,


-- ** resize #method:resize#
    MemoryResizeMethodInfo                  ,
    memoryResize                            ,


-- ** share #method:share#
    MemoryShareMethodInfo                   ,
    memoryShare                             ,


-- ** unmap #method:unmap#
    MemoryUnmapMethodInfo                   ,
    memoryUnmap                             ,




 -- * Properties
-- ** align #attr:align#
    getMemoryAlign                          ,
    memory_align                            ,
    setMemoryAlign                          ,


-- ** allocator #attr:allocator#
    clearMemoryAllocator                    ,
    getMemoryAllocator                      ,
    memory_allocator                        ,
    setMemoryAllocator                      ,


-- ** maxsize #attr:maxsize#
    getMemoryMaxsize                        ,
    memory_maxsize                          ,
    setMemoryMaxsize                        ,


-- ** miniObject #attr:miniObject#
    getMemoryMiniObject                     ,
    memory_miniObject                       ,


-- ** offset #attr:offset#
    getMemoryOffset                         ,
    memory_offset                           ,
    setMemoryOffset                         ,


-- ** parent #attr:parent#
    clearMemoryParent                       ,
    getMemoryParent                         ,
    memory_parent                           ,
    setMemoryParent                         ,


-- ** size #attr:size#
    getMemorySize                           ,
    memory_size                             ,
    setMemorySize                           ,




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP

import qualified GI.GLib.Callbacks as GLib.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.Structs.MapInfo as Gst.MapInfo
import {-# SOURCE #-} qualified GI.Gst.Structs.MiniObject as Gst.MiniObject

newtype Memory = Memory (ManagedPtr Memory)
foreign import ccall "gst_memory_get_type" c_gst_memory_get_type :: 
    IO GType

instance BoxedObject Memory where
    boxedType _ = c_gst_memory_get_type

-- | Construct a `Memory` struct initialized to zero.
newZeroMemory :: MonadIO m => m Memory
newZeroMemory = liftIO $ callocBoxedBytes 112 >>= wrapBoxed Memory

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


noMemory :: Maybe Memory
noMemory = Nothing

getMemoryMiniObject :: MonadIO m => Memory -> m Gst.MiniObject.MiniObject
getMemoryMiniObject s = liftIO $ withManagedPtr s $ \ptr -> do
    let val = ptr `plusPtr` 0 :: (Ptr Gst.MiniObject.MiniObject)
    val' <- (newPtr Gst.MiniObject.MiniObject) val
    return val'

data MemoryMiniObjectFieldInfo
instance AttrInfo MemoryMiniObjectFieldInfo where
    type AttrAllowedOps MemoryMiniObjectFieldInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint MemoryMiniObjectFieldInfo = (~) (Ptr Gst.MiniObject.MiniObject)
    type AttrBaseTypeConstraint MemoryMiniObjectFieldInfo = (~) Memory
    type AttrGetType MemoryMiniObjectFieldInfo = Gst.MiniObject.MiniObject
    type AttrLabel MemoryMiniObjectFieldInfo = "mini_object"
    type AttrOrigin MemoryMiniObjectFieldInfo = Memory
    attrGet _ = getMemoryMiniObject
    attrSet _ = undefined
    attrConstruct = undefined
    attrClear _ = undefined

memory_miniObject :: AttrLabelProxy "miniObject"
memory_miniObject = AttrLabelProxy


getMemoryAllocator :: MonadIO m => Memory -> m (Maybe Gst.Allocator.Allocator)
getMemoryAllocator s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 64) :: IO (Ptr Gst.Allocator.Allocator)
    result <- SP.convertIfNonNull val $ \val' -> do
        val'' <- (newObject Gst.Allocator.Allocator) val'
        return val''
    return result

setMemoryAllocator :: MonadIO m => Memory -> Ptr Gst.Allocator.Allocator -> m ()
setMemoryAllocator s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 64) (val :: Ptr Gst.Allocator.Allocator)

clearMemoryAllocator :: MonadIO m => Memory -> m ()
clearMemoryAllocator s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 64) (FP.nullPtr :: Ptr Gst.Allocator.Allocator)

data MemoryAllocatorFieldInfo
instance AttrInfo MemoryAllocatorFieldInfo where
    type AttrAllowedOps MemoryAllocatorFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint MemoryAllocatorFieldInfo = (~) (Ptr Gst.Allocator.Allocator)
    type AttrBaseTypeConstraint MemoryAllocatorFieldInfo = (~) Memory
    type AttrGetType MemoryAllocatorFieldInfo = Maybe Gst.Allocator.Allocator
    type AttrLabel MemoryAllocatorFieldInfo = "allocator"
    type AttrOrigin MemoryAllocatorFieldInfo = Memory
    attrGet _ = getMemoryAllocator
    attrSet _ = setMemoryAllocator
    attrConstruct = undefined
    attrClear _ = clearMemoryAllocator

memory_allocator :: AttrLabelProxy "allocator"
memory_allocator = AttrLabelProxy


getMemoryParent :: MonadIO m => Memory -> m (Maybe Memory)
getMemoryParent s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 72) :: IO (Ptr Memory)
    result <- SP.convertIfNonNull val $ \val' -> do
        val'' <- (newBoxed Memory) val'
        return val''
    return result

setMemoryParent :: MonadIO m => Memory -> Ptr Memory -> m ()
setMemoryParent s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 72) (val :: Ptr Memory)

clearMemoryParent :: MonadIO m => Memory -> m ()
clearMemoryParent s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 72) (FP.nullPtr :: Ptr Memory)

data MemoryParentFieldInfo
instance AttrInfo MemoryParentFieldInfo where
    type AttrAllowedOps MemoryParentFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint MemoryParentFieldInfo = (~) (Ptr Memory)
    type AttrBaseTypeConstraint MemoryParentFieldInfo = (~) Memory
    type AttrGetType MemoryParentFieldInfo = Maybe Memory
    type AttrLabel MemoryParentFieldInfo = "parent"
    type AttrOrigin MemoryParentFieldInfo = Memory
    attrGet _ = getMemoryParent
    attrSet _ = setMemoryParent
    attrConstruct = undefined
    attrClear _ = clearMemoryParent

memory_parent :: AttrLabelProxy "parent"
memory_parent = AttrLabelProxy


getMemoryMaxsize :: MonadIO m => Memory -> m Word64
getMemoryMaxsize s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 80) :: IO Word64
    return val

setMemoryMaxsize :: MonadIO m => Memory -> Word64 -> m ()
setMemoryMaxsize s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 80) (val :: Word64)

data MemoryMaxsizeFieldInfo
instance AttrInfo MemoryMaxsizeFieldInfo where
    type AttrAllowedOps MemoryMaxsizeFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint MemoryMaxsizeFieldInfo = (~) Word64
    type AttrBaseTypeConstraint MemoryMaxsizeFieldInfo = (~) Memory
    type AttrGetType MemoryMaxsizeFieldInfo = Word64
    type AttrLabel MemoryMaxsizeFieldInfo = "maxsize"
    type AttrOrigin MemoryMaxsizeFieldInfo = Memory
    attrGet _ = getMemoryMaxsize
    attrSet _ = setMemoryMaxsize
    attrConstruct = undefined
    attrClear _ = undefined

memory_maxsize :: AttrLabelProxy "maxsize"
memory_maxsize = AttrLabelProxy


getMemoryAlign :: MonadIO m => Memory -> m Word64
getMemoryAlign s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 88) :: IO Word64
    return val

setMemoryAlign :: MonadIO m => Memory -> Word64 -> m ()
setMemoryAlign s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 88) (val :: Word64)

data MemoryAlignFieldInfo
instance AttrInfo MemoryAlignFieldInfo where
    type AttrAllowedOps MemoryAlignFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint MemoryAlignFieldInfo = (~) Word64
    type AttrBaseTypeConstraint MemoryAlignFieldInfo = (~) Memory
    type AttrGetType MemoryAlignFieldInfo = Word64
    type AttrLabel MemoryAlignFieldInfo = "align"
    type AttrOrigin MemoryAlignFieldInfo = Memory
    attrGet _ = getMemoryAlign
    attrSet _ = setMemoryAlign
    attrConstruct = undefined
    attrClear _ = undefined

memory_align :: AttrLabelProxy "align"
memory_align = AttrLabelProxy


getMemoryOffset :: MonadIO m => Memory -> m Word64
getMemoryOffset s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 96) :: IO Word64
    return val

setMemoryOffset :: MonadIO m => Memory -> Word64 -> m ()
setMemoryOffset s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 96) (val :: Word64)

data MemoryOffsetFieldInfo
instance AttrInfo MemoryOffsetFieldInfo where
    type AttrAllowedOps MemoryOffsetFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint MemoryOffsetFieldInfo = (~) Word64
    type AttrBaseTypeConstraint MemoryOffsetFieldInfo = (~) Memory
    type AttrGetType MemoryOffsetFieldInfo = Word64
    type AttrLabel MemoryOffsetFieldInfo = "offset"
    type AttrOrigin MemoryOffsetFieldInfo = Memory
    attrGet _ = getMemoryOffset
    attrSet _ = setMemoryOffset
    attrConstruct = undefined
    attrClear _ = undefined

memory_offset :: AttrLabelProxy "offset"
memory_offset = AttrLabelProxy


getMemorySize :: MonadIO m => Memory -> m Word64
getMemorySize s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 104) :: IO Word64
    return val

setMemorySize :: MonadIO m => Memory -> Word64 -> m ()
setMemorySize s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 104) (val :: Word64)

data MemorySizeFieldInfo
instance AttrInfo MemorySizeFieldInfo where
    type AttrAllowedOps MemorySizeFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint MemorySizeFieldInfo = (~) Word64
    type AttrBaseTypeConstraint MemorySizeFieldInfo = (~) Memory
    type AttrGetType MemorySizeFieldInfo = Word64
    type AttrLabel MemorySizeFieldInfo = "size"
    type AttrOrigin MemorySizeFieldInfo = Memory
    attrGet _ = getMemorySize
    attrSet _ = setMemorySize
    attrConstruct = undefined
    attrClear _ = undefined

memory_size :: AttrLabelProxy "size"
memory_size = AttrLabelProxy



instance O.HasAttributeList Memory
type instance O.AttributeList Memory = MemoryAttributeList
type MemoryAttributeList = ('[ '("miniObject", MemoryMiniObjectFieldInfo), '("allocator", MemoryAllocatorFieldInfo), '("parent", MemoryParentFieldInfo), '("maxsize", MemoryMaxsizeFieldInfo), '("align", MemoryAlignFieldInfo), '("offset", MemoryOffsetFieldInfo), '("size", MemorySizeFieldInfo)] :: [(Symbol, *)])

-- method Memory::new_wrapped
-- 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\n  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 = "Memory"}))
-- throws : False
-- Skip return : False

foreign import ccall "gst_memory_new_wrapped" gst_memory_new_wrapped :: 
    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 Memory)

{- |
Allocate a new memory block that wraps the given /@data@/.

The prefix\/padding must be filled with 0 if /@flags@/ contains
@/GST_MEMORY_FLAG_ZERO_PREFIXED/@ and @/GST_MEMORY_FLAG_ZERO_PADDED/@ respectively.
-}
memoryNewWrapped ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    [Gst.Flags.MemoryFlags]
    {- ^ /@flags@/: '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 Memory
    {- ^ __Returns:__ a new 'GI.Gst.Structs.Memory.Memory'. -}
memoryNewWrapped flags data_ maxsize offset notify = liftIO $ do
    let size = fromIntegral $ B.length data_
    let flags' = gflagsToWord flags
    data_' <- packByteString data_
    ptrnotify <- callocMem :: IO (Ptr (FunPtr GLib.Callbacks.C_DestroyNotify))
    maybeNotify <- case notify of
        Nothing -> return (castPtrToFunPtr nullPtr)
        Just jNotify -> do
            jNotify' <- GLib.Callbacks.mk_DestroyNotify (GLib.Callbacks.wrap_DestroyNotify (Just ptrnotify) jNotify)
            poke ptrnotify jNotify'
            return jNotify'
    let userData = nullPtr
    result <- gst_memory_new_wrapped flags' data_' maxsize offset size userData maybeNotify
    checkUnexpectedReturnNULL "memoryNewWrapped" result
    result' <- (wrapBoxed Memory) result
    freeMem data_'
    return result'

-- method Memory::copy
-- method type : OrdinaryMethod
-- Args : [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 = TransferNothing},Arg {argCName = "offset", argType = TBasicType TInt64, 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 TInt64, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "size to copy, or -1 to copy to the end of the memory region", 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_memory_copy" gst_memory_copy :: 
    Ptr Memory ->                           -- mem : TInterface (Name {namespace = "Gst", name = "Memory"})
    Int64 ->                                -- offset : TBasicType TInt64
    Int64 ->                                -- size : TBasicType TInt64
    IO (Ptr Memory)

{- |
Return a copy of /@size@/ bytes from /@mem@/ starting from /@offset@/. This copy is
guaranteed to be writable. /@size@/ can be set to -1 to return a copy
from /@offset@/ to the end of the memory region.
-}
memoryCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Memory
    {- ^ /@mem@/: a 'GI.Gst.Structs.Memory.Memory' -}
    -> Int64
    {- ^ /@offset@/: offset to copy from -}
    -> Int64
    {- ^ /@size@/: size to copy, or -1 to copy to the end of the memory region -}
    -> m Memory
    {- ^ __Returns:__ a new 'GI.Gst.Structs.Memory.Memory'. -}
memoryCopy mem offset size = liftIO $ do
    mem' <- unsafeManagedPtrGetPtr mem
    result <- gst_memory_copy mem' offset size
    checkUnexpectedReturnNULL "memoryCopy" result
    result' <- (wrapBoxed Memory) result
    touchManagedPtr mem
    return result'

data MemoryCopyMethodInfo
instance (signature ~ (Int64 -> Int64 -> m Memory), MonadIO m) => O.MethodInfo MemoryCopyMethodInfo Memory signature where
    overloadedMethod _ = memoryCopy

-- method Memory::get_sizes
-- method type : OrdinaryMethod
-- Args : [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 = TransferNothing},Arg {argCName = "offset", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "pointer to offset", 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 "pointer to maxsize", 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_memory_get_sizes" gst_memory_get_sizes :: 
    Ptr Memory ->                           -- mem : TInterface (Name {namespace = "Gst", name = "Memory"})
    Word64 ->                               -- offset : TBasicType TUInt64
    Word64 ->                               -- maxsize : TBasicType TUInt64
    IO Word64

{- |
Get the current /@size@/, /@offset@/ and /@maxsize@/ of /@mem@/.
-}
memoryGetSizes ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Memory
    {- ^ /@mem@/: a 'GI.Gst.Structs.Memory.Memory' -}
    -> Word64
    {- ^ /@offset@/: pointer to offset -}
    -> Word64
    {- ^ /@maxsize@/: pointer to maxsize -}
    -> m Word64
    {- ^ __Returns:__ the current sizes of /@mem@/ -}
memoryGetSizes mem offset maxsize = liftIO $ do
    mem' <- unsafeManagedPtrGetPtr mem
    result <- gst_memory_get_sizes mem' offset maxsize
    touchManagedPtr mem
    return result

data MemoryGetSizesMethodInfo
instance (signature ~ (Word64 -> Word64 -> m Word64), MonadIO m) => O.MethodInfo MemoryGetSizesMethodInfo Memory signature where
    overloadedMethod _ = memoryGetSizes

-- method Memory::is_span
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "mem1", 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 = TransferNothing},Arg {argCName = "mem2", 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 = TransferNothing},Arg {argCName = "offset", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a pointer to a result 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_memory_is_span" gst_memory_is_span :: 
    Ptr Memory ->                           -- mem1 : TInterface (Name {namespace = "Gst", name = "Memory"})
    Ptr Memory ->                           -- mem2 : TInterface (Name {namespace = "Gst", name = "Memory"})
    Word64 ->                               -- offset : TBasicType TUInt64
    IO CInt

{- |
Check if /@mem1@/ and mem2 share the memory with a common parent memory object
and that the memory is contiguous.

If this is the case, the memory of /@mem1@/ and /@mem2@/ can be merged
efficiently by performing 'GI.Gst.Structs.Memory.memoryShare' on the parent object from
the returned /@offset@/.
-}
memoryIsSpan ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Memory
    {- ^ /@mem1@/: a 'GI.Gst.Structs.Memory.Memory' -}
    -> Memory
    {- ^ /@mem2@/: a 'GI.Gst.Structs.Memory.Memory' -}
    -> Word64
    {- ^ /@offset@/: a pointer to a result offset -}
    -> m Bool
    {- ^ __Returns:__ 'True' if the memory is contiguous and of a common parent. -}
memoryIsSpan mem1 mem2 offset = liftIO $ do
    mem1' <- unsafeManagedPtrGetPtr mem1
    mem2' <- unsafeManagedPtrGetPtr mem2
    result <- gst_memory_is_span mem1' mem2' offset
    let result' = (/= 0) result
    touchManagedPtr mem1
    touchManagedPtr mem2
    return result'

data MemoryIsSpanMethodInfo
instance (signature ~ (Memory -> Word64 -> m Bool), MonadIO m) => O.MethodInfo MemoryIsSpanMethodInfo Memory signature where
    overloadedMethod _ = memoryIsSpan

-- method Memory::is_type
-- method type : OrdinaryMethod
-- Args : [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 = TransferNothing},Arg {argCName = "mem_type", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a memory type", 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_memory_is_type" gst_memory_is_type :: 
    Ptr Memory ->                           -- mem : TInterface (Name {namespace = "Gst", name = "Memory"})
    CString ->                              -- mem_type : TBasicType TUTF8
    IO CInt

{- |
Check if /@mem@/ if allocated with an allocator for /@memType@/.

@since 1.2
-}
memoryIsType ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Memory
    {- ^ /@mem@/: a 'GI.Gst.Structs.Memory.Memory' -}
    -> T.Text
    {- ^ /@memType@/: a memory type -}
    -> m Bool
    {- ^ __Returns:__ 'True' if /@mem@/ was allocated from an allocator for /@memType@/. -}
memoryIsType mem memType = liftIO $ do
    mem' <- unsafeManagedPtrGetPtr mem
    memType' <- textToCString memType
    result <- gst_memory_is_type mem' memType'
    let result' = (/= 0) result
    touchManagedPtr mem
    freeMem memType'
    return result'

data MemoryIsTypeMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m) => O.MethodInfo MemoryIsTypeMethodInfo Memory signature where
    overloadedMethod _ = memoryIsType

-- method Memory::make_mapped
-- method type : OrdinaryMethod
-- Args : [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},Arg {argCName = "info", argType = TInterface (Name {namespace = "Gst", name = "MapInfo"}), direction = DirectionOut, mayBeNull = False, argDoc = Documentation {rawDocText = Just "pointer for info", 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 "mapping flags", 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_memory_make_mapped" gst_memory_make_mapped :: 
    Ptr Memory ->                           -- mem : TInterface (Name {namespace = "Gst", name = "Memory"})
    Ptr Gst.MapInfo.MapInfo ->              -- info : TInterface (Name {namespace = "Gst", name = "MapInfo"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gst", name = "MapFlags"})
    IO (Ptr Memory)

{- |
Create a 'GI.Gst.Structs.Memory.Memory' object that is mapped with /@flags@/. If /@mem@/ is mappable
with /@flags@/, this function returns the mapped /@mem@/ directly. Otherwise a
mapped copy of /@mem@/ is returned.

This function takes ownership of old /@mem@/ and returns a reference to a new
'GI.Gst.Structs.Memory.Memory'.
-}
memoryMakeMapped ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Memory
    {- ^ /@mem@/: a 'GI.Gst.Structs.Memory.Memory' -}
    -> [Gst.Flags.MapFlags]
    {- ^ /@flags@/: mapping flags -}
    -> m ((Maybe Memory),Gst.MapInfo.MapInfo)
    {- ^ __Returns:__ a 'GI.Gst.Structs.Memory.Memory' object mapped
with /@flags@/ or 'Nothing' when a mapping is not possible. -}
memoryMakeMapped mem flags = liftIO $ do
    mem' <- B.ManagedPtr.disownBoxed mem
    info <- callocBytes 104 :: IO (Ptr Gst.MapInfo.MapInfo)
    let flags' = gflagsToWord flags
    result <- gst_memory_make_mapped mem' info flags'
    maybeResult <- convertIfNonNull result $ \result' -> do
        result'' <- (wrapBoxed Memory) result'
        return result''
    info' <- (wrapPtr Gst.MapInfo.MapInfo) info
    touchManagedPtr mem
    return (maybeResult, info')

data MemoryMakeMappedMethodInfo
instance (signature ~ ([Gst.Flags.MapFlags] -> m ((Maybe Memory),Gst.MapInfo.MapInfo)), MonadIO m) => O.MethodInfo MemoryMakeMappedMethodInfo Memory signature where
    overloadedMethod _ = memoryMakeMapped

-- method Memory::map
-- method type : OrdinaryMethod
-- Args : [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 = TransferNothing},Arg {argCName = "info", argType = TInterface (Name {namespace = "Gst", name = "MapInfo"}), direction = DirectionOut, mayBeNull = False, argDoc = Documentation {rawDocText = Just "pointer for info", 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 "mapping flags", 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_memory_map" gst_memory_map :: 
    Ptr Memory ->                           -- mem : TInterface (Name {namespace = "Gst", name = "Memory"})
    Ptr Gst.MapInfo.MapInfo ->              -- info : TInterface (Name {namespace = "Gst", name = "MapInfo"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gst", name = "MapFlags"})
    IO CInt

{- |
Fill /@info@/ with the pointer and sizes of the memory in /@mem@/ that can be
accessed according to /@flags@/.

This function can return 'False' for various reasons:

* the memory backed by /@mem@/ is not accessible with the given /@flags@/.
* the memory was already mapped with a different mapping.


/@info@/ and its contents remain valid for as long as /@mem@/ is valid and
until 'GI.Gst.Structs.Memory.memoryUnmap' is called.

For each 'GI.Gst.Structs.Memory.memoryMap' call, a corresponding 'GI.Gst.Structs.Memory.memoryUnmap' call
should be done.
-}
memoryMap ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Memory
    {- ^ /@mem@/: a 'GI.Gst.Structs.Memory.Memory' -}
    -> [Gst.Flags.MapFlags]
    {- ^ /@flags@/: mapping flags -}
    -> m (Bool,Gst.MapInfo.MapInfo)
    {- ^ __Returns:__ 'True' if the map operation was successful. -}
memoryMap mem flags = liftIO $ do
    mem' <- unsafeManagedPtrGetPtr mem
    info <- callocBytes 104 :: IO (Ptr Gst.MapInfo.MapInfo)
    let flags' = gflagsToWord flags
    result <- gst_memory_map mem' info flags'
    let result' = (/= 0) result
    info' <- (wrapPtr Gst.MapInfo.MapInfo) info
    touchManagedPtr mem
    return (result', info')

data MemoryMapMethodInfo
instance (signature ~ ([Gst.Flags.MapFlags] -> m (Bool,Gst.MapInfo.MapInfo)), MonadIO m) => O.MethodInfo MemoryMapMethodInfo Memory signature where
    overloadedMethod _ = memoryMap

-- method Memory::resize
-- method type : OrdinaryMethod
-- Args : [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 = TransferNothing},Arg {argCName = "offset", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a new 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 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_memory_resize" gst_memory_resize :: 
    Ptr Memory ->                           -- mem : TInterface (Name {namespace = "Gst", name = "Memory"})
    Int64 ->                                -- offset : TBasicType TInt64
    Word64 ->                               -- size : TBasicType TUInt64
    IO ()

{- |
Resize the memory region. /@mem@/ should be writable and offset + size should be
less than the maxsize of /@mem@/.

@/GST_MEMORY_FLAG_ZERO_PREFIXED/@ and @/GST_MEMORY_FLAG_ZERO_PADDED/@ will be
cleared when offset or padding is increased respectively.
-}
memoryResize ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Memory
    {- ^ /@mem@/: a 'GI.Gst.Structs.Memory.Memory' -}
    -> Int64
    {- ^ /@offset@/: a new offset -}
    -> Word64
    {- ^ /@size@/: a new size -}
    -> m ()
memoryResize mem offset size = liftIO $ do
    mem' <- unsafeManagedPtrGetPtr mem
    gst_memory_resize mem' offset size
    touchManagedPtr mem
    return ()

data MemoryResizeMethodInfo
instance (signature ~ (Int64 -> Word64 -> m ()), MonadIO m) => O.MethodInfo MemoryResizeMethodInfo Memory signature where
    overloadedMethod _ = memoryResize

-- method Memory::share
-- method type : OrdinaryMethod
-- Args : [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 = TransferNothing},Arg {argCName = "offset", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "offset to share from", 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 "size to share, or -1 to share to the end of the memory region", 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_memory_share" gst_memory_share :: 
    Ptr Memory ->                           -- mem : TInterface (Name {namespace = "Gst", name = "Memory"})
    Int64 ->                                -- offset : TBasicType TInt64
    Int64 ->                                -- size : TBasicType TInt64
    IO (Ptr Memory)

{- |
Return a shared copy of /@size@/ bytes from /@mem@/ starting from /@offset@/. No
memory copy is performed and the memory region is simply shared. The result
is guaranteed to be non-writable. /@size@/ can be set to -1 to return a shared
copy from /@offset@/ to the end of the memory region.
-}
memoryShare ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Memory
    {- ^ /@mem@/: a 'GI.Gst.Structs.Memory.Memory' -}
    -> Int64
    {- ^ /@offset@/: offset to share from -}
    -> Int64
    {- ^ /@size@/: size to share, or -1 to share to the end of the memory region -}
    -> m Memory
    {- ^ __Returns:__ a new 'GI.Gst.Structs.Memory.Memory'. -}
memoryShare mem offset size = liftIO $ do
    mem' <- unsafeManagedPtrGetPtr mem
    result <- gst_memory_share mem' offset size
    checkUnexpectedReturnNULL "memoryShare" result
    result' <- (wrapBoxed Memory) result
    touchManagedPtr mem
    return result'

data MemoryShareMethodInfo
instance (signature ~ (Int64 -> Int64 -> m Memory), MonadIO m) => O.MethodInfo MemoryShareMethodInfo Memory signature where
    overloadedMethod _ = memoryShare

-- method Memory::unmap
-- method type : OrdinaryMethod
-- Args : [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 = 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_memory_unmap" gst_memory_unmap :: 
    Ptr Memory ->                           -- mem : TInterface (Name {namespace = "Gst", name = "Memory"})
    Ptr Gst.MapInfo.MapInfo ->              -- info : TInterface (Name {namespace = "Gst", name = "MapInfo"})
    IO ()

{- |
Release the memory obtained with 'GI.Gst.Structs.Memory.memoryMap'
-}
memoryUnmap ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Memory
    {- ^ /@mem@/: a 'GI.Gst.Structs.Memory.Memory' -}
    -> Gst.MapInfo.MapInfo
    {- ^ /@info@/: a 'GI.Gst.Structs.MapInfo.MapInfo' -}
    -> m ()
memoryUnmap mem info = liftIO $ do
    mem' <- unsafeManagedPtrGetPtr mem
    info' <- unsafeManagedPtrGetPtr info
    gst_memory_unmap mem' info'
    touchManagedPtr mem
    touchManagedPtr info
    return ()

data MemoryUnmapMethodInfo
instance (signature ~ (Gst.MapInfo.MapInfo -> m ()), MonadIO m) => O.MethodInfo MemoryUnmapMethodInfo Memory signature where
    overloadedMethod _ = memoryUnmap

type family ResolveMemoryMethod (t :: Symbol) (o :: *) :: * where
    ResolveMemoryMethod "copy" o = MemoryCopyMethodInfo
    ResolveMemoryMethod "isSpan" o = MemoryIsSpanMethodInfo
    ResolveMemoryMethod "isType" o = MemoryIsTypeMethodInfo
    ResolveMemoryMethod "makeMapped" o = MemoryMakeMappedMethodInfo
    ResolveMemoryMethod "map" o = MemoryMapMethodInfo
    ResolveMemoryMethod "resize" o = MemoryResizeMethodInfo
    ResolveMemoryMethod "share" o = MemoryShareMethodInfo
    ResolveMemoryMethod "unmap" o = MemoryUnmapMethodInfo
    ResolveMemoryMethod "getSizes" o = MemoryGetSizesMethodInfo
    ResolveMemoryMethod l o = O.MethodResolutionFailed l o

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

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