{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Interface for an array of bytes. It is expected to be subclassed to implement
-- /@resize@/ virtual method using language native array implementation, such as
-- GLib\'s t'GI.GLib.Structs.ByteArray.ByteArray', C++\'s @std::vector\<uint8_t>@ or Rust\'s @Vec\<u8>@.
-- 
-- /@resize@/ implementation could allocate more than requested to avoid repeated
-- reallocations. It can return 'P.False', or be set to 'P.Nothing', in the case the
-- array cannot grow.
-- 
-- /Since: 1.24/

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

module GI.Gst.Structs.ByteArrayInterface
    ( 

-- * Exported types
    ByteArrayInterface(..)                  ,
    newZeroByteArrayInterface               ,


 -- * Methods

#if defined(ENABLE_OVERLOADING)
    ResolveByteArrayInterfaceMethod         ,
#endif



 -- * Properties


-- ** data #attr:data#
-- | A pointer to an array of bytes.

#if defined(ENABLE_OVERLOADING)
    byteArrayInterface_data                 ,
#endif
    getByteArrayInterfaceData               ,
    setByteArrayInterfaceData               ,


-- ** len #attr:len#
-- | Number of bytes in /@data@/.

#if defined(ENABLE_OVERLOADING)
    byteArrayInterface_len                  ,
#endif
    getByteArrayInterfaceLen                ,
    setByteArrayInterfaceLen                ,


-- ** resize #attr:resize#
-- | Reallocate /@data@/.

#if defined(ENABLE_OVERLOADING)
    byteArrayInterface_resize               ,
#endif
    clearByteArrayInterfaceResize           ,
    getByteArrayInterfaceResize             ,
    setByteArrayInterfaceResize             ,




    ) 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.Kind as DK
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 Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import qualified GI.Gst.Callbacks as Gst.Callbacks

#else
import qualified GI.Gst.Callbacks as Gst.Callbacks

#endif

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

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

instance BoxedPtr ByteArrayInterface where
    boxedPtrCopy :: ByteArrayInterface -> IO ByteArrayInterface
boxedPtrCopy = \ByteArrayInterface
p -> ByteArrayInterface
-> (Ptr ByteArrayInterface -> IO ByteArrayInterface)
-> IO ByteArrayInterface
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr ByteArrayInterface
p (Int -> Ptr ByteArrayInterface -> IO (Ptr ByteArrayInterface)
forall a. (HasCallStack, CallocPtr a) => Int -> Ptr a -> IO (Ptr a)
copyBytes Int
56 (Ptr ByteArrayInterface -> IO (Ptr ByteArrayInterface))
-> (Ptr ByteArrayInterface -> IO ByteArrayInterface)
-> Ptr ByteArrayInterface
-> IO ByteArrayInterface
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (ManagedPtr ByteArrayInterface -> ByteArrayInterface)
-> Ptr ByteArrayInterface -> IO ByteArrayInterface
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.wrapPtr ManagedPtr ByteArrayInterface -> ByteArrayInterface
ByteArrayInterface)
    boxedPtrFree :: ByteArrayInterface -> IO ()
boxedPtrFree = \ByteArrayInterface
x -> ByteArrayInterface -> (Ptr ByteArrayInterface -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
SP.withManagedPtr ByteArrayInterface
x Ptr ByteArrayInterface -> IO ()
forall a. Ptr a -> IO ()
SP.freeMem
instance CallocPtr ByteArrayInterface where
    boxedPtrCalloc :: IO (Ptr ByteArrayInterface)
boxedPtrCalloc = Int -> IO (Ptr ByteArrayInterface)
forall a. Int -> IO (Ptr a)
callocBytes Int
56


-- | Construct a `ByteArrayInterface` struct initialized to zero.
newZeroByteArrayInterface :: MonadIO m => m ByteArrayInterface
newZeroByteArrayInterface :: forall (m :: * -> *). MonadIO m => m ByteArrayInterface
newZeroByteArrayInterface = IO ByteArrayInterface -> m ByteArrayInterface
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteArrayInterface -> m ByteArrayInterface)
-> IO ByteArrayInterface -> m ByteArrayInterface
forall a b. (a -> b) -> a -> b
$ IO (Ptr ByteArrayInterface)
forall a. CallocPtr a => IO (Ptr a)
boxedPtrCalloc IO (Ptr ByteArrayInterface)
-> (Ptr ByteArrayInterface -> IO ByteArrayInterface)
-> IO ByteArrayInterface
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr ByteArrayInterface -> ByteArrayInterface)
-> Ptr ByteArrayInterface -> IO ByteArrayInterface
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr ByteArrayInterface -> ByteArrayInterface
ByteArrayInterface

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


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

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

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

byteArrayInterface_data :: AttrLabelProxy "data"
byteArrayInterface_data = AttrLabelProxy

#endif


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

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

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

byteArrayInterface_len :: AttrLabelProxy "len"
byteArrayInterface_len = AttrLabelProxy

#endif


-- | Get the value of the “@resize@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' byteArrayInterface #resize
-- @
getByteArrayInterfaceResize :: MonadIO m => ByteArrayInterface -> m (Maybe Gst.Callbacks.ByteArrayInterfaceResizeFieldCallback)
getByteArrayInterfaceResize :: forall (m :: * -> *).
MonadIO m =>
ByteArrayInterface
-> m (Maybe ByteArrayInterfaceResizeFieldCallback)
getByteArrayInterfaceResize ByteArrayInterface
s = IO (Maybe ByteArrayInterfaceResizeFieldCallback)
-> m (Maybe ByteArrayInterfaceResizeFieldCallback)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ByteArrayInterfaceResizeFieldCallback)
 -> m (Maybe ByteArrayInterfaceResizeFieldCallback))
-> IO (Maybe ByteArrayInterfaceResizeFieldCallback)
-> m (Maybe ByteArrayInterfaceResizeFieldCallback)
forall a b. (a -> b) -> a -> b
$ ByteArrayInterface
-> (Ptr ByteArrayInterface
    -> IO (Maybe ByteArrayInterfaceResizeFieldCallback))
-> IO (Maybe ByteArrayInterfaceResizeFieldCallback)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ByteArrayInterface
s ((Ptr ByteArrayInterface
  -> IO (Maybe ByteArrayInterfaceResizeFieldCallback))
 -> IO (Maybe ByteArrayInterfaceResizeFieldCallback))
-> (Ptr ByteArrayInterface
    -> IO (Maybe ByteArrayInterfaceResizeFieldCallback))
-> IO (Maybe ByteArrayInterfaceResizeFieldCallback)
forall a b. (a -> b) -> a -> b
$ \Ptr ByteArrayInterface
ptr -> do
    FunPtr C_ByteArrayInterfaceResizeFieldCallback
val <- Ptr (FunPtr C_ByteArrayInterfaceResizeFieldCallback)
-> IO (FunPtr C_ByteArrayInterfaceResizeFieldCallback)
forall a. Storable a => Ptr a -> IO a
peek (Ptr ByteArrayInterface
ptr Ptr ByteArrayInterface
-> Int -> Ptr (FunPtr C_ByteArrayInterfaceResizeFieldCallback)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) :: IO (FunPtr Gst.Callbacks.C_ByteArrayInterfaceResizeFieldCallback)
    Maybe ByteArrayInterfaceResizeFieldCallback
result <- FunPtr C_ByteArrayInterfaceResizeFieldCallback
-> (FunPtr C_ByteArrayInterfaceResizeFieldCallback
    -> IO ByteArrayInterfaceResizeFieldCallback)
-> IO (Maybe ByteArrayInterfaceResizeFieldCallback)
forall a b. FunPtr a -> (FunPtr a -> IO b) -> IO (Maybe b)
SP.convertFunPtrIfNonNull FunPtr C_ByteArrayInterfaceResizeFieldCallback
val ((FunPtr C_ByteArrayInterfaceResizeFieldCallback
  -> IO ByteArrayInterfaceResizeFieldCallback)
 -> IO (Maybe ByteArrayInterfaceResizeFieldCallback))
-> (FunPtr C_ByteArrayInterfaceResizeFieldCallback
    -> IO ByteArrayInterfaceResizeFieldCallback)
-> IO (Maybe ByteArrayInterfaceResizeFieldCallback)
forall a b. (a -> b) -> a -> b
$ \FunPtr C_ByteArrayInterfaceResizeFieldCallback
val' -> do
        let val'' :: ByteArrayInterfaceResizeFieldCallback
val'' = FunPtr C_ByteArrayInterfaceResizeFieldCallback
-> ByteArrayInterfaceResizeFieldCallback
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FunPtr C_ByteArrayInterfaceResizeFieldCallback
-> ByteArrayInterface -> CSize -> m Bool
Gst.Callbacks.dynamic_ByteArrayInterfaceResizeFieldCallback FunPtr C_ByteArrayInterfaceResizeFieldCallback
val'
        ByteArrayInterfaceResizeFieldCallback
-> IO ByteArrayInterfaceResizeFieldCallback
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteArrayInterfaceResizeFieldCallback
val''
    Maybe ByteArrayInterfaceResizeFieldCallback
-> IO (Maybe ByteArrayInterfaceResizeFieldCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteArrayInterfaceResizeFieldCallback
result

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

-- | Set the value of the “@resize@” 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' #resize
-- @
clearByteArrayInterfaceResize :: MonadIO m => ByteArrayInterface -> m ()
clearByteArrayInterfaceResize :: forall (m :: * -> *). MonadIO m => ByteArrayInterface -> m ()
clearByteArrayInterfaceResize ByteArrayInterface
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
$ ByteArrayInterface -> (Ptr ByteArrayInterface -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ByteArrayInterface
s ((Ptr ByteArrayInterface -> IO ()) -> IO ())
-> (Ptr ByteArrayInterface -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ByteArrayInterface
ptr -> do
    Ptr (FunPtr C_ByteArrayInterfaceResizeFieldCallback)
-> FunPtr C_ByteArrayInterfaceResizeFieldCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ByteArrayInterface
ptr Ptr ByteArrayInterface
-> Int -> Ptr (FunPtr C_ByteArrayInterfaceResizeFieldCallback)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) (FunPtr C_ByteArrayInterfaceResizeFieldCallback
forall a. FunPtr a
FP.nullFunPtr :: FunPtr Gst.Callbacks.C_ByteArrayInterfaceResizeFieldCallback)

#if defined(ENABLE_OVERLOADING)
data ByteArrayInterfaceResizeFieldInfo
instance AttrInfo ByteArrayInterfaceResizeFieldInfo where
    type AttrBaseTypeConstraint ByteArrayInterfaceResizeFieldInfo = (~) ByteArrayInterface
    type AttrAllowedOps ByteArrayInterfaceResizeFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint ByteArrayInterfaceResizeFieldInfo = (~) (FunPtr Gst.Callbacks.C_ByteArrayInterfaceResizeFieldCallback)
    type AttrTransferTypeConstraint ByteArrayInterfaceResizeFieldInfo = (~)Gst.Callbacks.ByteArrayInterfaceResizeFieldCallback
    type AttrTransferType ByteArrayInterfaceResizeFieldInfo = (FunPtr Gst.Callbacks.C_ByteArrayInterfaceResizeFieldCallback)
    type AttrGetType ByteArrayInterfaceResizeFieldInfo = Maybe Gst.Callbacks.ByteArrayInterfaceResizeFieldCallback
    type AttrLabel ByteArrayInterfaceResizeFieldInfo = "resize"
    type AttrOrigin ByteArrayInterfaceResizeFieldInfo = ByteArrayInterface
    attrGet = getByteArrayInterfaceResize
    attrSet = setByteArrayInterfaceResize
    attrConstruct = undefined
    attrClear = clearByteArrayInterfaceResize
    attrTransfer _ v = do
        Gst.Callbacks.mk_ByteArrayInterfaceResizeFieldCallback (Gst.Callbacks.wrap_ByteArrayInterfaceResizeFieldCallback Nothing v)
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.ByteArrayInterface.resize"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.30/docs/GI-Gst-Structs-ByteArrayInterface.html#g:attr:resize"
        })

byteArrayInterface_resize :: AttrLabelProxy "resize"
byteArrayInterface_resize = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList ByteArrayInterface
type instance O.AttributeList ByteArrayInterface = ByteArrayInterfaceAttributeList
type ByteArrayInterfaceAttributeList = ('[ '("data", ByteArrayInterfaceDataFieldInfo), '("len", ByteArrayInterfaceLenFieldInfo), '("resize", ByteArrayInterfaceResizeFieldInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveByteArrayInterfaceMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveByteArrayInterfaceMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif