{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Contains the public fields of a GByteArray.

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

module GI.GLib.Structs.ByteArray
    ( 

-- * Exported types
    ByteArray(..)                           ,
    newZeroByteArray                        ,


 -- * Methods

#if defined(ENABLE_OVERLOADING)
    ResolveByteArrayMethod                  ,
#endif

-- ** append #method:append#

    byteArrayAppend                         ,


-- ** free #method:free#

    byteArrayFree                           ,


-- ** freeToBytes #method:freeToBytes#

    byteArrayFreeToBytes                    ,


-- ** new #method:new#

    byteArrayNew                            ,


-- ** newTake #method:newTake#

    byteArrayNewTake                        ,


-- ** prepend #method:prepend#

    byteArrayPrepend                        ,


-- ** ref #method:ref#

    byteArrayRef                            ,


-- ** removeIndex #method:removeIndex#

    byteArrayRemoveIndex                    ,


-- ** removeIndexFast #method:removeIndexFast#

    byteArrayRemoveIndexFast                ,


-- ** removeRange #method:removeRange#

    byteArrayRemoveRange                    ,


-- ** setSize #method:setSize#

    byteArraySetSize                        ,


-- ** sizedNew #method:sizedNew#

    byteArraySizedNew                       ,


-- ** sort #method:sort#

    byteArraySort                           ,


-- ** sortWithData #method:sortWithData#

    byteArraySortWithData                   ,


-- ** steal #method:steal#

    byteArraySteal                          ,


-- ** unref #method:unref#

    byteArrayUnref                          ,




 -- * Properties


-- ** data #attr:data#
-- | a pointer to the element data. The data may be moved as
--     elements are added to the t'GI.GLib.Structs.ByteArray.ByteArray'

#if defined(ENABLE_OVERLOADING)
    byteArray_data                          ,
#endif
    getByteArrayData                        ,
    setByteArrayData                        ,


-- ** len #attr:len#
-- | the number of elements in the t'GI.GLib.Structs.ByteArray.ByteArray'

#if defined(ENABLE_OVERLOADING)
    byteArray_len                           ,
#endif
    getByteArrayLen                         ,
    setByteArrayLen                         ,




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

#else
import qualified GI.GLib.Callbacks as GLib.Callbacks
import {-# SOURCE #-} qualified GI.GLib.Structs.Bytes as GLib.Bytes

#endif

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

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

foreign import ccall "g_byte_array_get_type" c_g_byte_array_get_type :: 
    IO GType

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

instance B.Types.TypedObject ByteArray where
    glibType :: IO GType
glibType = IO GType
c_g_byte_array_get_type

instance B.Types.GBoxed ByteArray

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

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

instance tag ~ 'AttrSet => Constructible ByteArray tag where
    new :: forall (m :: * -> *).
MonadIO m =>
(ManagedPtr ByteArray -> ByteArray)
-> [AttrOp ByteArray tag] -> m ByteArray
new ManagedPtr ByteArray -> ByteArray
_ [AttrOp ByteArray tag]
attrs = do
        ByteArray
o <- m ByteArray
forall (m :: * -> *). MonadIO m => m ByteArray
newZeroByteArray
        ByteArray -> [AttrOp ByteArray 'AttrSet] -> m ()
forall o (m :: * -> *).
MonadIO m =>
o -> [AttrOp o 'AttrSet] -> m ()
GI.Attributes.set ByteArray
o [AttrOp ByteArray tag]
[AttrOp ByteArray 'AttrSet]
attrs
        ByteArray -> m ByteArray
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteArray
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' byteArray #data
-- @
getByteArrayData :: MonadIO m => ByteArray -> m Word8
getByteArrayData :: forall (m :: * -> *). MonadIO m => ByteArray -> m Word8
getByteArrayData ByteArray
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
$ ByteArray -> (Ptr ByteArray -> IO Word8) -> IO Word8
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ByteArray
s ((Ptr ByteArray -> IO Word8) -> IO Word8)
-> (Ptr ByteArray -> IO Word8) -> IO Word8
forall a b. (a -> b) -> a -> b
$ \Ptr ByteArray
ptr -> do
    Word8
val <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek (Ptr ByteArray
ptr Ptr ByteArray -> 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' byteArray [ #data 'Data.GI.Base.Attributes.:=' value ]
-- @
setByteArrayData :: MonadIO m => ByteArray -> Word8 -> m ()
setByteArrayData :: forall (m :: * -> *). MonadIO m => ByteArray -> Word8 -> m ()
setByteArrayData ByteArray
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
$ ByteArray -> (Ptr ByteArray -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ByteArray
s ((Ptr ByteArray -> IO ()) -> IO ())
-> (Ptr ByteArray -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ByteArray
ptr -> do
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ByteArray
ptr Ptr ByteArray -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (Word8
val :: Word8)

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

byteArray_data :: AttrLabelProxy "data"
byteArray_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' byteArray #len
-- @
getByteArrayLen :: MonadIO m => ByteArray -> m Word32
getByteArrayLen :: forall (m :: * -> *). MonadIO m => ByteArray -> m Word32
getByteArrayLen ByteArray
s = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ ByteArray -> (Ptr ByteArray -> IO Word32) -> IO Word32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ByteArray
s ((Ptr ByteArray -> IO Word32) -> IO Word32)
-> (Ptr ByteArray -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ \Ptr ByteArray
ptr -> do
    Word32
val <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek (Ptr ByteArray
ptr Ptr ByteArray -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) :: IO Word32
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
val

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

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

byteArray_len :: AttrLabelProxy "len"
byteArray_len = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList ByteArray
type instance O.AttributeList ByteArray = ByteArrayAttributeList
type ByteArrayAttributeList = ('[ '("data", ByteArrayDataFieldInfo), '("len", ByteArrayLenFieldInfo)] :: [(Symbol, DK.Type)])
#endif

-- method ByteArray::append
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "array"
--           , argType = TByteArray
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GByteArray" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TBasicType TUInt8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the byte data to be added"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "len"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of bytes to add"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just TByteArray
-- throws : False
-- Skip return : False

foreign import ccall "g_byte_array_append" g_byte_array_append :: 
    Ptr GByteArray ->                       -- array : TByteArray
    Word8 ->                                -- data : TBasicType TUInt8
    Word32 ->                               -- len : TBasicType TUInt
    IO (Ptr GByteArray)

-- | Adds the given bytes to the end of the t'GI.GLib.Structs.ByteArray.ByteArray'.
-- The array will grow in size automatically if necessary.
byteArrayAppend ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ByteString
    -- ^ /@array@/: a t'GI.GLib.Structs.ByteArray.ByteArray'
    -> Word8
    -- ^ /@data@/: the byte data to be added
    -> Word32
    -- ^ /@len@/: the number of bytes to add
    -> m ByteString
    -- ^ __Returns:__ the t'GI.GLib.Structs.ByteArray.ByteArray'
byteArrayAppend :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ByteString -> Word8 -> Word32 -> m ByteString
byteArrayAppend ByteString
array Word8
data_ Word32
len = 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 GByteArray
array' <- ByteString -> IO (Ptr GByteArray)
packGByteArray ByteString
array
    Ptr GByteArray
result <- Ptr GByteArray -> Word8 -> Word32 -> IO (Ptr GByteArray)
g_byte_array_append Ptr GByteArray
array' Word8
data_ Word32
len
    Text -> Ptr GByteArray -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"byteArrayAppend" Ptr GByteArray
result
    ByteString
result' <- Ptr GByteArray -> IO ByteString
unpackGByteArray Ptr GByteArray
result
    Ptr GByteArray -> IO ()
unrefGByteArray Ptr GByteArray
array'
    ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method ByteArray::free
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "array"
--           , argType = TByteArray
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GByteArray" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "free_segment"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "if %TRUE the actual byte data is freed as well"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt8)
-- throws : False
-- Skip return : False

foreign import ccall "g_byte_array_free" g_byte_array_free :: 
    Ptr GByteArray ->                       -- array : TByteArray
    CInt ->                                 -- free_segment : TBasicType TBoolean
    IO Word8

-- | Frees the memory allocated by the t'GI.GLib.Structs.ByteArray.ByteArray'. If /@freeSegment@/ is
-- 'P.True' it frees the actual byte data. If the reference count of
-- /@array@/ is greater than one, the t'GI.GLib.Structs.ByteArray.ByteArray' wrapper is preserved but
-- the size of /@array@/ will be set to zero.
byteArrayFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ByteString
    -- ^ /@array@/: a t'GI.GLib.Structs.ByteArray.ByteArray'
    -> Bool
    -- ^ /@freeSegment@/: if 'P.True' the actual byte data is freed as well
    -> m Word8
    -- ^ __Returns:__ the element data if /@freeSegment@/ is 'P.False', otherwise
    --          'P.Nothing'.  The element data should be freed using 'GI.GLib.Functions.free'.
byteArrayFree :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ByteString -> Bool -> m Word8
byteArrayFree ByteString
array Bool
freeSegment = 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
$ do
    Ptr GByteArray
array' <- ByteString -> IO (Ptr GByteArray)
packGByteArray ByteString
array
    let freeSegment' :: CInt
freeSegment' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
freeSegment
    Word8
result <- Ptr GByteArray -> CInt -> IO Word8
g_byte_array_free Ptr GByteArray
array' CInt
freeSegment'
    Ptr GByteArray -> IO ()
unrefGByteArray Ptr GByteArray
array'
    Word8 -> IO Word8
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word8
result

#if defined(ENABLE_OVERLOADING)
#endif

-- method ByteArray::free_to_bytes
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "array"
--           , argType = TByteArray
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GByteArray" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GLib" , name = "Bytes" })
-- throws : False
-- Skip return : False

foreign import ccall "g_byte_array_free_to_bytes" g_byte_array_free_to_bytes :: 
    Ptr GByteArray ->                       -- array : TByteArray
    IO (Ptr GLib.Bytes.Bytes)

-- | Transfers the data from the t'GI.GLib.Structs.ByteArray.ByteArray' into a new immutable t'GI.GLib.Structs.Bytes.Bytes'.
-- 
-- The t'GI.GLib.Structs.ByteArray.ByteArray' is freed unless the reference count of /@array@/ is greater
-- than one, the t'GI.GLib.Structs.ByteArray.ByteArray' wrapper is preserved but the size of /@array@/
-- will be set to zero.
-- 
-- This is identical to using 'GI.GLib.Structs.Bytes.bytesNewTake' and 'GI.GLib.Functions.byteArrayFree'
-- together.
-- 
-- /Since: 2.32/
byteArrayFreeToBytes ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ByteString
    -- ^ /@array@/: a t'GI.GLib.Structs.ByteArray.ByteArray'
    -> m GLib.Bytes.Bytes
    -- ^ __Returns:__ a new immutable t'GI.GLib.Structs.Bytes.Bytes' representing same
    --     byte data that was in the array
byteArrayFreeToBytes :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ByteString -> m Bytes
byteArrayFreeToBytes ByteString
array = IO Bytes -> m Bytes
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bytes -> m Bytes) -> IO Bytes -> m Bytes
forall a b. (a -> b) -> a -> b
$ do
    Ptr GByteArray
array' <- ByteString -> IO (Ptr GByteArray)
packGByteArray ByteString
array
    Ptr Bytes
result <- Ptr GByteArray -> IO (Ptr Bytes)
g_byte_array_free_to_bytes Ptr GByteArray
array'
    Text -> Ptr Bytes -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"byteArrayFreeToBytes" Ptr Bytes
result
    Bytes
result' <- ((ManagedPtr Bytes -> Bytes) -> Ptr Bytes -> IO Bytes
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Bytes -> Bytes
GLib.Bytes.Bytes) Ptr Bytes
result
    Bytes -> IO Bytes
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bytes
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method ByteArray::new
-- method type : MemberFunction
-- Args: []
-- Lengths: []
-- returnType: Just TByteArray
-- throws : False
-- Skip return : False

foreign import ccall "g_byte_array_new" g_byte_array_new :: 
    IO (Ptr GByteArray)

-- | Creates a new t'GI.GLib.Structs.ByteArray.ByteArray' with a reference count of 1.
byteArrayNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m ByteString
    -- ^ __Returns:__ the new t'GI.GLib.Structs.ByteArray.ByteArray'
byteArrayNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m ByteString
byteArrayNew  = 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 GByteArray
result <- IO (Ptr GByteArray)
g_byte_array_new
    Text -> Ptr GByteArray -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"byteArrayNew" Ptr GByteArray
result
    ByteString
result' <- Ptr GByteArray -> IO ByteString
unpackGByteArray Ptr GByteArray
result
    Ptr GByteArray -> IO ()
unrefGByteArray Ptr GByteArray
result
    ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method ByteArray::new_take
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "data"
--           , argType = TCArray False (-1) 1 (TBasicType TUInt8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "byte data for the array"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "len"
--           , argType = TBasicType TSize
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "length of @data" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "len"
--              , argType = TBasicType TSize
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "length of @data" , sinceVersion = Nothing }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , argCallbackUserData = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just TByteArray
-- throws : False
-- Skip return : False

foreign import ccall "g_byte_array_new_take" g_byte_array_new_take :: 
    Ptr Word8 ->                            -- data : TCArray False (-1) 1 (TBasicType TUInt8)
    FCT.CSize ->                            -- len : TBasicType TSize
    IO (Ptr GByteArray)

-- | Creates a byte array containing the /@data@/.
-- After this call, /@data@/ belongs to the t'GI.GLib.Structs.ByteArray.ByteArray' and may no longer be
-- modified by the caller. The memory of /@data@/ has to be dynamically
-- allocated and will eventually be freed with 'GI.GLib.Functions.free'.
-- 
-- Do not use it if /@len@/ is greater than @/G_MAXUINT/@. t'GI.GLib.Structs.ByteArray.ByteArray'
-- stores the length of its data in @/guint/@, which may be shorter than
-- @/gsize/@.
-- 
-- /Since: 2.32/
byteArrayNewTake ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ByteString
    -- ^ /@data@/: byte data for the array
    -> m ByteString
    -- ^ __Returns:__ a new t'GI.GLib.Structs.ByteArray.ByteArray'
byteArrayNewTake :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ByteString -> m ByteString
byteArrayNewTake ByteString
data_ = 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
    let len :: CSize
len = Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CSize) -> Int -> CSize
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
data_
    Ptr Word8
data_' <- ByteString -> IO (Ptr Word8)
packByteString ByteString
data_
    Ptr GByteArray
result <- Ptr Word8 -> CSize -> IO (Ptr GByteArray)
g_byte_array_new_take Ptr Word8
data_' CSize
len
    Text -> Ptr GByteArray -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"byteArrayNewTake" Ptr GByteArray
result
    ByteString
result' <- Ptr GByteArray -> IO ByteString
unpackGByteArray Ptr GByteArray
result
    Ptr GByteArray -> IO ()
unrefGByteArray Ptr GByteArray
result
    ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method ByteArray::prepend
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "array"
--           , argType = TByteArray
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GByteArray" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TBasicType TUInt8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the byte data to be added"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "len"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of bytes to add"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just TByteArray
-- throws : False
-- Skip return : False

foreign import ccall "g_byte_array_prepend" g_byte_array_prepend :: 
    Ptr GByteArray ->                       -- array : TByteArray
    Word8 ->                                -- data : TBasicType TUInt8
    Word32 ->                               -- len : TBasicType TUInt
    IO (Ptr GByteArray)

-- | Adds the given data to the start of the t'GI.GLib.Structs.ByteArray.ByteArray'.
-- The array will grow in size automatically if necessary.
byteArrayPrepend ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ByteString
    -- ^ /@array@/: a t'GI.GLib.Structs.ByteArray.ByteArray'
    -> Word8
    -- ^ /@data@/: the byte data to be added
    -> Word32
    -- ^ /@len@/: the number of bytes to add
    -> m ByteString
    -- ^ __Returns:__ the t'GI.GLib.Structs.ByteArray.ByteArray'
byteArrayPrepend :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ByteString -> Word8 -> Word32 -> m ByteString
byteArrayPrepend ByteString
array Word8
data_ Word32
len = 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 GByteArray
array' <- ByteString -> IO (Ptr GByteArray)
packGByteArray ByteString
array
    Ptr GByteArray
result <- Ptr GByteArray -> Word8 -> Word32 -> IO (Ptr GByteArray)
g_byte_array_prepend Ptr GByteArray
array' Word8
data_ Word32
len
    Text -> Ptr GByteArray -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"byteArrayPrepend" Ptr GByteArray
result
    ByteString
result' <- Ptr GByteArray -> IO ByteString
unpackGByteArray Ptr GByteArray
result
    Ptr GByteArray -> IO ()
unrefGByteArray Ptr GByteArray
array'
    ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method ByteArray::ref
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "array"
--           , argType = TByteArray
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GByteArray" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just TByteArray
-- throws : False
-- Skip return : False

foreign import ccall "g_byte_array_ref" g_byte_array_ref :: 
    Ptr GByteArray ->                       -- array : TByteArray
    IO (Ptr GByteArray)

-- | Atomically increments the reference count of /@array@/ by one.
-- This function is thread-safe and may be called from any thread.
-- 
-- /Since: 2.22/
byteArrayRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ByteString
    -- ^ /@array@/: A t'GI.GLib.Structs.ByteArray.ByteArray'
    -> m ByteString
    -- ^ __Returns:__ The passed in t'GI.GLib.Structs.ByteArray.ByteArray'
byteArrayRef :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ByteString -> m ByteString
byteArrayRef ByteString
array = 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 GByteArray
array' <- ByteString -> IO (Ptr GByteArray)
packGByteArray ByteString
array
    Ptr GByteArray
result <- Ptr GByteArray -> IO (Ptr GByteArray)
g_byte_array_ref Ptr GByteArray
array'
    Text -> Ptr GByteArray -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"byteArrayRef" Ptr GByteArray
result
    ByteString
result' <- Ptr GByteArray -> IO ByteString
unpackGByteArray Ptr GByteArray
result
    Ptr GByteArray -> IO ()
unrefGByteArray Ptr GByteArray
result
    Ptr GByteArray -> IO ()
unrefGByteArray Ptr GByteArray
array'
    ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method ByteArray::remove_index
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "array"
--           , argType = TByteArray
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GByteArray" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index_"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the index of the byte to remove"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just TByteArray
-- throws : False
-- Skip return : False

foreign import ccall "g_byte_array_remove_index" g_byte_array_remove_index :: 
    Ptr GByteArray ->                       -- array : TByteArray
    Word32 ->                               -- index_ : TBasicType TUInt
    IO (Ptr GByteArray)

-- | Removes the byte at the given index from a t'GI.GLib.Structs.ByteArray.ByteArray'.
-- The following bytes are moved down one place.
byteArrayRemoveIndex ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ByteString
    -- ^ /@array@/: a t'GI.GLib.Structs.ByteArray.ByteArray'
    -> Word32
    -- ^ /@index_@/: the index of the byte to remove
    -> m ByteString
    -- ^ __Returns:__ the t'GI.GLib.Structs.ByteArray.ByteArray'
byteArrayRemoveIndex :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ByteString -> Word32 -> m ByteString
byteArrayRemoveIndex ByteString
array Word32
index_ = 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 GByteArray
array' <- ByteString -> IO (Ptr GByteArray)
packGByteArray ByteString
array
    Ptr GByteArray
result <- Ptr GByteArray -> Word32 -> IO (Ptr GByteArray)
g_byte_array_remove_index Ptr GByteArray
array' Word32
index_
    Text -> Ptr GByteArray -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"byteArrayRemoveIndex" Ptr GByteArray
result
    ByteString
result' <- Ptr GByteArray -> IO ByteString
unpackGByteArray Ptr GByteArray
result
    Ptr GByteArray -> IO ()
unrefGByteArray Ptr GByteArray
array'
    ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method ByteArray::remove_index_fast
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "array"
--           , argType = TByteArray
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GByteArray" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index_"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the index of the byte to remove"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just TByteArray
-- throws : False
-- Skip return : False

foreign import ccall "g_byte_array_remove_index_fast" g_byte_array_remove_index_fast :: 
    Ptr GByteArray ->                       -- array : TByteArray
    Word32 ->                               -- index_ : TBasicType TUInt
    IO (Ptr GByteArray)

-- | Removes the byte at the given index from a t'GI.GLib.Structs.ByteArray.ByteArray'. The last
-- element in the array is used to fill in the space, so this function
-- does not preserve the order of the t'GI.GLib.Structs.ByteArray.ByteArray'. But it is faster
-- than 'GI.GLib.Functions.byteArrayRemoveIndex'.
byteArrayRemoveIndexFast ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ByteString
    -- ^ /@array@/: a t'GI.GLib.Structs.ByteArray.ByteArray'
    -> Word32
    -- ^ /@index_@/: the index of the byte to remove
    -> m ByteString
    -- ^ __Returns:__ the t'GI.GLib.Structs.ByteArray.ByteArray'
byteArrayRemoveIndexFast :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ByteString -> Word32 -> m ByteString
byteArrayRemoveIndexFast ByteString
array Word32
index_ = 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 GByteArray
array' <- ByteString -> IO (Ptr GByteArray)
packGByteArray ByteString
array
    Ptr GByteArray
result <- Ptr GByteArray -> Word32 -> IO (Ptr GByteArray)
g_byte_array_remove_index_fast Ptr GByteArray
array' Word32
index_
    Text -> Ptr GByteArray -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"byteArrayRemoveIndexFast" Ptr GByteArray
result
    ByteString
result' <- Ptr GByteArray -> IO ByteString
unpackGByteArray Ptr GByteArray
result
    Ptr GByteArray -> IO ()
unrefGByteArray Ptr GByteArray
array'
    ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method ByteArray::remove_range
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "array"
--           , argType = TByteArray
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a @GByteArray" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index_"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the index of the first byte to remove"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of bytes to remove"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just TByteArray
-- throws : False
-- Skip return : False

foreign import ccall "g_byte_array_remove_range" g_byte_array_remove_range :: 
    Ptr GByteArray ->                       -- array : TByteArray
    Word32 ->                               -- index_ : TBasicType TUInt
    Word32 ->                               -- length : TBasicType TUInt
    IO (Ptr GByteArray)

-- | Removes the given number of bytes starting at the given index from a
-- t'GI.GLib.Structs.ByteArray.ByteArray'.  The following elements are moved to close the gap.
-- 
-- /Since: 2.4/
byteArrayRemoveRange ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ByteString
    -- ^ /@array@/: a /@gByteArray@/
    -> Word32
    -- ^ /@index_@/: the index of the first byte to remove
    -> Word32
    -- ^ /@length@/: the number of bytes to remove
    -> m ByteString
    -- ^ __Returns:__ the t'GI.GLib.Structs.ByteArray.ByteArray'
byteArrayRemoveRange :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ByteString -> Word32 -> Word32 -> m ByteString
byteArrayRemoveRange ByteString
array Word32
index_ Word32
length_ = 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 GByteArray
array' <- ByteString -> IO (Ptr GByteArray)
packGByteArray ByteString
array
    Ptr GByteArray
result <- Ptr GByteArray -> Word32 -> Word32 -> IO (Ptr GByteArray)
g_byte_array_remove_range Ptr GByteArray
array' Word32
index_ Word32
length_
    Text -> Ptr GByteArray -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"byteArrayRemoveRange" Ptr GByteArray
result
    ByteString
result' <- Ptr GByteArray -> IO ByteString
unpackGByteArray Ptr GByteArray
result
    Ptr GByteArray -> IO ()
unrefGByteArray Ptr GByteArray
array'
    ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method ByteArray::set_size
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "array"
--           , argType = TByteArray
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GByteArray" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new size of the #GByteArray"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just TByteArray
-- throws : False
-- Skip return : False

foreign import ccall "g_byte_array_set_size" g_byte_array_set_size :: 
    Ptr GByteArray ->                       -- array : TByteArray
    Word32 ->                               -- length : TBasicType TUInt
    IO (Ptr GByteArray)

-- | Sets the size of the t'GI.GLib.Structs.ByteArray.ByteArray', expanding it if necessary.
byteArraySetSize ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ByteString
    -- ^ /@array@/: a t'GI.GLib.Structs.ByteArray.ByteArray'
    -> Word32
    -- ^ /@length@/: the new size of the t'GI.GLib.Structs.ByteArray.ByteArray'
    -> m ByteString
    -- ^ __Returns:__ the t'GI.GLib.Structs.ByteArray.ByteArray'
byteArraySetSize :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ByteString -> Word32 -> m ByteString
byteArraySetSize ByteString
array Word32
length_ = 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 GByteArray
array' <- ByteString -> IO (Ptr GByteArray)
packGByteArray ByteString
array
    Ptr GByteArray
result <- Ptr GByteArray -> Word32 -> IO (Ptr GByteArray)
g_byte_array_set_size Ptr GByteArray
array' Word32
length_
    Text -> Ptr GByteArray -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"byteArraySetSize" Ptr GByteArray
result
    ByteString
result' <- Ptr GByteArray -> IO ByteString
unpackGByteArray Ptr GByteArray
result
    Ptr GByteArray -> IO ()
unrefGByteArray Ptr GByteArray
array'
    ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method ByteArray::sized_new
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "reserved_size"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of bytes preallocated"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just TByteArray
-- throws : False
-- Skip return : False

foreign import ccall "g_byte_array_sized_new" g_byte_array_sized_new :: 
    Word32 ->                               -- reserved_size : TBasicType TUInt
    IO (Ptr GByteArray)

-- | Creates a new t'GI.GLib.Structs.ByteArray.ByteArray' with /@reservedSize@/ bytes preallocated.
-- This avoids frequent reallocation, if you are going to add many
-- bytes to the array. Note however that the size of the array is still
-- 0.
byteArraySizedNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Word32
    -- ^ /@reservedSize@/: number of bytes preallocated
    -> m ByteString
    -- ^ __Returns:__ the new t'GI.GLib.Structs.ByteArray.ByteArray'
byteArraySizedNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Word32 -> m ByteString
byteArraySizedNew Word32
reservedSize = 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 GByteArray
result <- Word32 -> IO (Ptr GByteArray)
g_byte_array_sized_new Word32
reservedSize
    Text -> Ptr GByteArray -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"byteArraySizedNew" Ptr GByteArray
result
    ByteString
result' <- Ptr GByteArray -> IO ByteString
unpackGByteArray Ptr GByteArray
result
    Ptr GByteArray -> IO ()
unrefGByteArray Ptr GByteArray
result
    ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method ByteArray::sort
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "array"
--           , argType = TByteArray
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GByteArray" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "compare_func"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "CompareFunc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "comparison function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeCall
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_byte_array_sort" g_byte_array_sort :: 
    Ptr GByteArray ->                       -- array : TByteArray
    FunPtr GLib.Callbacks.C_CompareFunc ->  -- compare_func : TInterface (Name {namespace = "GLib", name = "CompareFunc"})
    IO ()

-- | Sorts a byte array, using /@compareFunc@/ which should be a
-- @/qsort()/@-style comparison function (returns less than zero for first
-- arg is less than second arg, zero for equal, greater than zero if
-- first arg is greater than second arg).
-- 
-- If two array elements compare equal, their order in the sorted array
-- is undefined. If you want equal elements to keep their order (i.e.
-- you want a stable sort) you can write a comparison function that,
-- if two elements would otherwise compare equal, compares them by
-- their addresses.
byteArraySort ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ByteString
    -- ^ /@array@/: a t'GI.GLib.Structs.ByteArray.ByteArray'
    -> GLib.Callbacks.CompareFunc
    -- ^ /@compareFunc@/: comparison function
    -> m ()
byteArraySort :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ByteString -> CompareFunc -> m ()
byteArraySort ByteString
array CompareFunc
compareFunc = 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 GByteArray
array' <- ByteString -> IO (Ptr GByteArray)
packGByteArray ByteString
array
    FunPtr C_CompareFunc
compareFunc' <- C_CompareFunc -> IO (FunPtr C_CompareFunc)
GLib.Callbacks.mk_CompareFunc (Maybe (Ptr (FunPtr C_CompareFunc))
-> C_CompareFunc -> C_CompareFunc
GLib.Callbacks.wrap_CompareFunc Maybe (Ptr (FunPtr C_CompareFunc))
forall a. Maybe a
Nothing (CompareFunc -> C_CompareFunc
GLib.Callbacks.drop_closures_CompareFunc CompareFunc
compareFunc))
    Ptr GByteArray -> FunPtr C_CompareFunc -> IO ()
g_byte_array_sort Ptr GByteArray
array' FunPtr C_CompareFunc
compareFunc'
    Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_CompareFunc -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_CompareFunc
compareFunc'
    Ptr GByteArray -> IO ()
unrefGByteArray Ptr GByteArray
array'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
#endif

-- method ByteArray::sort_with_data
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "array"
--           , argType = TByteArray
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GByteArray" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "compare_func"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "CompareDataFunc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "comparison function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeCall
--           , argClosure = 2
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to pass to @compare_func"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_byte_array_sort_with_data" g_byte_array_sort_with_data :: 
    Ptr GByteArray ->                       -- array : TByteArray
    FunPtr GLib.Callbacks.C_CompareDataFunc -> -- compare_func : TInterface (Name {namespace = "GLib", name = "CompareDataFunc"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Like 'GI.GLib.Functions.byteArraySort', but the comparison function takes an extra
-- user data argument.
byteArraySortWithData ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ByteString
    -- ^ /@array@/: a t'GI.GLib.Structs.ByteArray.ByteArray'
    -> GLib.Callbacks.CompareDataFunc
    -- ^ /@compareFunc@/: comparison function
    -> m ()
byteArraySortWithData :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ByteString -> C_CompareFunc -> m ()
byteArraySortWithData ByteString
array C_CompareFunc
compareFunc = 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 GByteArray
array' <- ByteString -> IO (Ptr GByteArray)
packGByteArray ByteString
array
    FunPtr C_CompareDataFunc
compareFunc' <- C_CompareDataFunc -> IO (FunPtr C_CompareDataFunc)
GLib.Callbacks.mk_CompareDataFunc (Maybe (Ptr (FunPtr C_CompareDataFunc))
-> C_CompareDataFunc -> C_CompareDataFunc
GLib.Callbacks.wrap_CompareDataFunc Maybe (Ptr (FunPtr C_CompareDataFunc))
forall a. Maybe a
Nothing (C_CompareFunc -> C_CompareDataFunc
GLib.Callbacks.drop_closures_CompareDataFunc C_CompareFunc
compareFunc))
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr GByteArray -> FunPtr C_CompareDataFunc -> Ptr () -> IO ()
g_byte_array_sort_with_data Ptr GByteArray
array' FunPtr C_CompareDataFunc
compareFunc' Ptr ()
forall a. Ptr a
userData
    Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_CompareDataFunc -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_CompareDataFunc
compareFunc'
    Ptr GByteArray -> IO ()
unrefGByteArray Ptr GByteArray
array'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
#endif

-- method ByteArray::steal
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "array"
--           , argType = TByteArray
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GByteArray." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "len"
--           , argType = TBasicType TSize
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "pointer to retrieve the number of\n   elements of the original array"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt8)
-- throws : False
-- Skip return : False

foreign import ccall "g_byte_array_steal" g_byte_array_steal :: 
    Ptr GByteArray ->                       -- array : TByteArray
    Ptr FCT.CSize ->                        -- len : TBasicType TSize
    IO Word8

-- | Frees the data in the array and resets the size to zero, while
-- the underlying array is preserved for use elsewhere and returned
-- to the caller.
-- 
-- /Since: 2.64/
byteArraySteal ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ByteString
    -- ^ /@array@/: a t'GI.GLib.Structs.ByteArray.ByteArray'.
    -> m ((Word8, FCT.CSize))
    -- ^ __Returns:__ the element data, which should be
    --     freed using 'GI.GLib.Functions.free'.
byteArraySteal :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ByteString -> m (Word8, CSize)
byteArraySteal ByteString
array = IO (Word8, CSize) -> m (Word8, CSize)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Word8, CSize) -> m (Word8, CSize))
-> IO (Word8, CSize) -> m (Word8, CSize)
forall a b. (a -> b) -> a -> b
$ do
    Ptr GByteArray
array' <- ByteString -> IO (Ptr GByteArray)
packGByteArray ByteString
array
    Ptr CSize
len <- IO (Ptr CSize)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr FCT.CSize)
    Word8
result <- Ptr GByteArray -> Ptr CSize -> IO Word8
g_byte_array_steal Ptr GByteArray
array' Ptr CSize
len
    CSize
len' <- Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
len
    Ptr GByteArray -> IO ()
unrefGByteArray Ptr GByteArray
array'
    Ptr CSize -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CSize
len
    (Word8, CSize) -> IO (Word8, CSize)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8
result, CSize
len')

#if defined(ENABLE_OVERLOADING)
#endif

-- method ByteArray::unref
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "array"
--           , argType = TByteArray
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GByteArray" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_byte_array_unref" g_byte_array_unref :: 
    Ptr GByteArray ->                       -- array : TByteArray
    IO ()

-- | Atomically decrements the reference count of /@array@/ by one. If the
-- reference count drops to 0, all memory allocated by the array is
-- released. This function is thread-safe and may be called from any
-- thread.
-- 
-- /Since: 2.22/
byteArrayUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ByteString
    -- ^ /@array@/: A t'GI.GLib.Structs.ByteArray.ByteArray'
    -> m ()
byteArrayUnref :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ByteString -> m ()
byteArrayUnref ByteString
array = 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 GByteArray
array' <- ByteString -> IO (Ptr GByteArray)
packGByteArray ByteString
array
    Ptr GByteArray -> IO ()
g_byte_array_unref Ptr GByteArray
array'
    Ptr GByteArray -> IO ()
unrefGByteArray Ptr GByteArray
array'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
#endif

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

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

#endif

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

#endif