{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A data buffer, generally used to represent a chunk of a
-- t'GI.Soup.Structs.MessageBody.MessageBody'.
-- 
-- /@data@/ is a @/char/@ because that\'s generally convenient; in some
-- situations you may need to cast it to @/guchar/@ or another type.

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

module GI.Soup.Structs.Buffer
    ( 

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


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolveBufferMethod                     ,
#endif


-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    BufferCopyMethodInfo                    ,
#endif
    bufferCopy                              ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    BufferFreeMethodInfo                    ,
#endif
    bufferFree                              ,


-- ** getAsBytes #method:getAsBytes#

#if defined(ENABLE_OVERLOADING)
    BufferGetAsBytesMethodInfo              ,
#endif
    bufferGetAsBytes                        ,


-- ** getData #method:getData#

#if defined(ENABLE_OVERLOADING)
    BufferGetDataMethodInfo                 ,
#endif
    bufferGetData                           ,


-- ** getOwner #method:getOwner#

#if defined(ENABLE_OVERLOADING)
    BufferGetOwnerMethodInfo                ,
#endif
    bufferGetOwner                          ,


-- ** new #method:new#

    bufferNew                               ,


-- ** newSubbuffer #method:newSubbuffer#

#if defined(ENABLE_OVERLOADING)
    BufferNewSubbufferMethodInfo            ,
#endif
    bufferNewSubbuffer                      ,


-- ** newWithOwner #method:newWithOwner#

    bufferNewWithOwner                      ,




 -- * Properties
-- ** data #attr:data#
-- | the data

#if defined(ENABLE_OVERLOADING)
    buffer_data                             ,
#endif
    clearBufferData                         ,
    getBufferData                           ,
    setBufferData                           ,


-- ** length #attr:length#
-- | length of /@data@/

#if defined(ENABLE_OVERLOADING)
    buffer_length                           ,
#endif
    getBufferLength                         ,
    setBufferLength                         ,




    ) 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.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
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.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

import qualified GI.GLib.Callbacks as GLib.Callbacks
import qualified GI.GLib.Structs.Bytes as GLib.Bytes

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

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

foreign import ccall "soup_buffer_get_type" c_soup_buffer_get_type :: 
    IO GType

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

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

instance B.Types.GBoxed Buffer

-- | Convert 'Buffer' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue Buffer where
    toGValue :: Buffer -> IO GValue
toGValue Buffer
o = do
        GType
gtype <- IO GType
c_soup_buffer_get_type
        Buffer -> (Ptr Buffer -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Buffer
o (GType -> (GValue -> Ptr Buffer -> IO ()) -> Ptr Buffer -> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr Buffer -> IO ()
forall a. GValue -> Ptr a -> IO ()
B.GValue.set_boxed)
        
    fromGValue :: GValue -> IO Buffer
fromGValue GValue
gv = do
        Ptr Buffer
ptr <- GValue -> IO (Ptr Buffer)
forall b. GValue -> IO (Ptr b)
B.GValue.get_boxed GValue
gv :: IO (Ptr Buffer)
        (ManagedPtr Buffer -> Buffer) -> Ptr Buffer -> IO Buffer
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr Buffer -> Buffer
Buffer Ptr Buffer
ptr
        
    

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

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

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

#if defined(ENABLE_OVERLOADING)
data BufferDataFieldInfo
instance AttrInfo BufferDataFieldInfo where
    type AttrBaseTypeConstraint BufferDataFieldInfo = (~) Buffer
    type AttrAllowedOps BufferDataFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint BufferDataFieldInfo = (~) (Ptr ())
    type AttrTransferTypeConstraint BufferDataFieldInfo = (~)(Ptr ())
    type AttrTransferType BufferDataFieldInfo = (Ptr ())
    type AttrGetType BufferDataFieldInfo = Ptr ()
    type AttrLabel BufferDataFieldInfo = "data"
    type AttrOrigin BufferDataFieldInfo = Buffer
    attrGet = getBufferData
    attrSet = setBufferData
    attrConstruct = undefined
    attrClear = clearBufferData
    attrTransfer _ v = do
        return v

buffer_data :: AttrLabelProxy "data"
buffer_data = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data BufferLengthFieldInfo
instance AttrInfo BufferLengthFieldInfo where
    type AttrBaseTypeConstraint BufferLengthFieldInfo = (~) Buffer
    type AttrAllowedOps BufferLengthFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint BufferLengthFieldInfo = (~) Word64
    type AttrTransferTypeConstraint BufferLengthFieldInfo = (~)Word64
    type AttrTransferType BufferLengthFieldInfo = Word64
    type AttrGetType BufferLengthFieldInfo = Word64
    type AttrLabel BufferLengthFieldInfo = "length"
    type AttrOrigin BufferLengthFieldInfo = Buffer
    attrGet = getBufferLength
    attrSet = setBufferLength
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

buffer_length :: AttrLabelProxy "length"
buffer_length = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Buffer
type instance O.AttributeList Buffer = BufferAttributeList
type BufferAttributeList = ('[ '("data", BufferDataFieldInfo), '("length", BufferLengthFieldInfo)] :: [(Symbol, *)])
#endif

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

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

-- | Creates a new t'GI.Soup.Structs.Buffer.Buffer' containing /@length@/ bytes from /@data@/.
-- 
-- This function is exactly equivalent to @/soup_buffer_new()/@ with
-- 'GI.Soup.Enums.MemoryUseTake' as first argument; it exists mainly for
-- convenience and simplifying language bindings.
-- 
-- /Since: 2.32/
bufferNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ByteString
    -- ^ /@data@/: data
    -> m Buffer
    -- ^ __Returns:__ the new t'GI.Soup.Structs.Buffer.Buffer'.
bufferNew :: ByteString -> m Buffer
bufferNew ByteString
data_ = IO Buffer -> m Buffer
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Buffer -> m Buffer) -> IO Buffer -> m Buffer
forall a b. (a -> b) -> a -> b
$ do
    let length_ :: Word64
length_ = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
data_
    Ptr Word8
data_' <- ByteString -> IO (Ptr Word8)
packByteString ByteString
data_
    Ptr Buffer
result <- Ptr Word8 -> Word64 -> IO (Ptr Buffer)
soup_buffer_new_take Ptr Word8
data_' Word64
length_
    Text -> Ptr Buffer -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"bufferNew" Ptr Buffer
result
    Buffer
result' <- ((ManagedPtr Buffer -> Buffer) -> Ptr Buffer -> IO Buffer
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Buffer -> Buffer
Buffer) Ptr Buffer
result
    Buffer -> IO Buffer
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Buffer::new_with_owner
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "data"
--           , argType = TCArray False (-1) 1 (TBasicType TUInt8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "data" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "length of @data" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "owner"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "pointer to an object that owns @data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "owner_dnotify"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a function to free/unref @owner when\nthe buffer is freed"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "length"
--              , argType = TBasicType TUInt64
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "length of @data" , sinceVersion = Nothing }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just (TInterface Name { namespace = "Soup" , name = "Buffer" })
-- throws : False
-- Skip return : False

foreign import ccall "soup_buffer_new_with_owner" soup_buffer_new_with_owner :: 
    Ptr Word8 ->                            -- data : TCArray False (-1) 1 (TBasicType TUInt8)
    Word64 ->                               -- length : TBasicType TUInt64
    Ptr () ->                               -- owner : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- owner_dnotify : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO (Ptr Buffer)

-- | Creates a new t'GI.Soup.Structs.Buffer.Buffer' containing /@length@/ bytes from /@data@/. When
-- the t'GI.Soup.Structs.Buffer.Buffer' is freed, it will call /@ownerDnotify@/, passing
-- /@owner@/ to it. You must ensure that /@data@/ will remain valid until
-- /@ownerDnotify@/ is called.
-- 
-- For example, you could use this to create a buffer containing data
-- returned from libxml without needing to do an extra copy:
-- 
-- \<informalexample>\<programlisting>
-- xmlDocDumpMemory (doc, &xmlbody, &len);
-- return soup_buffer_new_with_owner (xmlbody, len, xmlbody,
--                                    (GDestroyNotify)xmlFree);
-- \<\/programlisting>\<\/informalexample>
-- 
-- In this example, /@data@/ and /@owner@/ are the same, but in other cases
-- they would be different (eg, /@owner@/ would be a object, and /@data@/
-- would be a pointer to one of the object\'s fields).
bufferNewWithOwner ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ByteString
    -- ^ /@data@/: data
    -> Ptr ()
    -- ^ /@owner@/: pointer to an object that owns /@data@/
    -> Maybe (GLib.Callbacks.DestroyNotify)
    -- ^ /@ownerDnotify@/: a function to free\/unref /@owner@/ when
    -- the buffer is freed
    -> m Buffer
    -- ^ __Returns:__ the new t'GI.Soup.Structs.Buffer.Buffer'.
bufferNewWithOwner :: ByteString -> Ptr () -> Maybe (Ptr () -> IO ()) -> m Buffer
bufferNewWithOwner ByteString
data_ Ptr ()
owner Maybe (Ptr () -> IO ())
ownerDnotify = IO Buffer -> m Buffer
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Buffer -> m Buffer) -> IO Buffer -> m Buffer
forall a b. (a -> b) -> a -> b
$ do
    let length_ :: Word64
length_ = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
data_
    Ptr Word8
data_' <- ByteString -> IO (Ptr Word8)
packByteString ByteString
data_
    FunPtr (Ptr () -> IO ())
maybeOwnerDnotify <- case Maybe (Ptr () -> IO ())
ownerDnotify of
        Maybe (Ptr () -> IO ())
Nothing -> FunPtr (Ptr () -> IO ()) -> IO (FunPtr (Ptr () -> IO ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr (Ptr () -> IO ())
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just Ptr () -> IO ()
jOwnerDnotify -> do
            Ptr (FunPtr (Ptr () -> IO ()))
ptrownerDnotify <- IO (Ptr (FunPtr (Ptr () -> IO ())))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr GLib.Callbacks.C_DestroyNotify))
            FunPtr (Ptr () -> IO ())
jOwnerDnotify' <- (Ptr () -> IO ()) -> IO (FunPtr (Ptr () -> IO ()))
GLib.Callbacks.mk_DestroyNotify (Maybe (Ptr (FunPtr (Ptr () -> IO ())))
-> (Ptr () -> IO ()) -> Ptr () -> IO ()
GLib.Callbacks.wrap_DestroyNotify (Ptr (FunPtr (Ptr () -> IO ()))
-> Maybe (Ptr (FunPtr (Ptr () -> IO ())))
forall a. a -> Maybe a
Just Ptr (FunPtr (Ptr () -> IO ()))
ptrownerDnotify) Ptr () -> IO ()
jOwnerDnotify)
            Ptr (FunPtr (Ptr () -> IO ())) -> FunPtr (Ptr () -> IO ()) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr (Ptr () -> IO ()))
ptrownerDnotify FunPtr (Ptr () -> IO ())
jOwnerDnotify'
            FunPtr (Ptr () -> IO ()) -> IO (FunPtr (Ptr () -> IO ()))
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr (Ptr () -> IO ())
jOwnerDnotify'
    Ptr Buffer
result <- Ptr Word8
-> Word64 -> Ptr () -> FunPtr (Ptr () -> IO ()) -> IO (Ptr Buffer)
soup_buffer_new_with_owner Ptr Word8
data_' Word64
length_ Ptr ()
owner FunPtr (Ptr () -> IO ())
maybeOwnerDnotify
    Text -> Ptr Buffer -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"bufferNewWithOwner" Ptr Buffer
result
    Buffer
result' <- ((ManagedPtr Buffer -> Buffer) -> Ptr Buffer -> IO Buffer
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Buffer -> Buffer
Buffer) Ptr Buffer
result
    Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
data_'
    Buffer -> IO Buffer
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

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

-- | Makes a copy of /@buffer@/. In reality, t'GI.Soup.Structs.Buffer.Buffer' is a refcounted
-- type, and calling 'GI.Soup.Structs.Buffer.bufferCopy' will normally just increment
-- the refcount on /@buffer@/ and return it. However, if /@buffer@/ was
-- created with @/SOUP_MEMORY_TEMPORARY/@ memory, then 'GI.Soup.Structs.Buffer.bufferCopy'
-- will actually return a copy of it, so that the data in the copy
-- will remain valid after the temporary buffer is freed.
bufferCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@buffer@/: a t'GI.Soup.Structs.Buffer.Buffer'
    -> m Buffer
    -- ^ __Returns:__ the new (or newly-reffed) buffer
bufferCopy :: Buffer -> m Buffer
bufferCopy Buffer
buffer = IO Buffer -> m Buffer
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Buffer -> m Buffer) -> IO Buffer -> m Buffer
forall a b. (a -> b) -> a -> b
$ do
    Ptr Buffer
buffer' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
buffer
    Ptr Buffer
result <- Ptr Buffer -> IO (Ptr Buffer)
soup_buffer_copy Ptr Buffer
buffer'
    Text -> Ptr Buffer -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"bufferCopy" Ptr Buffer
result
    Buffer
result' <- ((ManagedPtr Buffer -> Buffer) -> Ptr Buffer -> IO Buffer
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Buffer -> Buffer
Buffer) Ptr Buffer
result
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    Buffer -> IO Buffer
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer
result'

#if defined(ENABLE_OVERLOADING)
data BufferCopyMethodInfo
instance (signature ~ (m Buffer), MonadIO m) => O.MethodInfo BufferCopyMethodInfo Buffer signature where
    overloadedMethod = bufferCopy

#endif

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

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

-- | Frees /@buffer@/. (In reality, as described in the documentation for
-- 'GI.Soup.Structs.Buffer.bufferCopy', this is actually an \"unref\" operation, and may
-- or may not actually free /@buffer@/.)
bufferFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@buffer@/: a t'GI.Soup.Structs.Buffer.Buffer'
    -> m ()
bufferFree :: Buffer -> m ()
bufferFree Buffer
buffer = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Buffer
buffer' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
buffer
    Ptr Buffer -> IO ()
soup_buffer_free Ptr Buffer
buffer'
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BufferFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo BufferFreeMethodInfo Buffer signature where
    overloadedMethod = bufferFree

#endif

-- method Buffer::get_as_bytes
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buffer"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Buffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupBuffer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GLib" , name = "Bytes" })
-- throws : False
-- Skip return : False

foreign import ccall "soup_buffer_get_as_bytes" soup_buffer_get_as_bytes :: 
    Ptr Buffer ->                           -- buffer : TInterface (Name {namespace = "Soup", name = "Buffer"})
    IO (Ptr GLib.Bytes.Bytes)

-- | Creates a t'GI.GLib.Structs.Bytes.Bytes' pointing to the same memory as /@buffer@/. The
-- t'GI.GLib.Structs.Bytes.Bytes' will hold a reference on /@buffer@/ to ensure that it is not
-- freed while the t'GI.GLib.Structs.Bytes.Bytes' is still valid.
-- 
-- /Since: 2.40/
bufferGetAsBytes ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@buffer@/: a t'GI.Soup.Structs.Buffer.Buffer'
    -> m GLib.Bytes.Bytes
    -- ^ __Returns:__ a new t'GI.GLib.Structs.Bytes.Bytes' which has the same content
    -- as the t'GI.Soup.Structs.Buffer.Buffer'.
bufferGetAsBytes :: Buffer -> m Bytes
bufferGetAsBytes Buffer
buffer = IO Bytes -> m Bytes
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 Buffer
buffer' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
buffer
    Ptr Bytes
result <- Ptr Buffer -> IO (Ptr Bytes)
soup_buffer_get_as_bytes Ptr Buffer
buffer'
    Text -> Ptr Bytes -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"bufferGetAsBytes" 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
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    Bytes -> IO Bytes
forall (m :: * -> *) a. Monad m => a -> m a
return Bytes
result'

#if defined(ENABLE_OVERLOADING)
data BufferGetAsBytesMethodInfo
instance (signature ~ (m GLib.Bytes.Bytes), MonadIO m) => O.MethodInfo BufferGetAsBytesMethodInfo Buffer signature where
    overloadedMethod = bufferGetAsBytes

#endif

-- method Buffer::get_data
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buffer"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Buffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupBuffer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TCArray False (-1) 2 (TBasicType TUInt8)
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the pointer\nto the buffer data is stored here"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the length of the buffer data is stored here"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "length"
--              , argType = TBasicType TUInt64
--              , direction = DirectionOut
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the length of the buffer data is stored here"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferEverything
--              }
--          ]
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_buffer_get_data" soup_buffer_get_data :: 
    Ptr Buffer ->                           -- buffer : TInterface (Name {namespace = "Soup", name = "Buffer"})
    Ptr (Ptr Word8) ->                      -- data : TCArray False (-1) 2 (TBasicType TUInt8)
    Ptr Word64 ->                           -- length : TBasicType TUInt64
    IO ()

-- | This function exists for use by language bindings, because it\'s not
-- currently possible to get the right effect by annotating the fields
-- of t'GI.Soup.Structs.Buffer.Buffer'.
-- 
-- /Since: 2.32/
bufferGetData ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@buffer@/: a t'GI.Soup.Structs.Buffer.Buffer'
    -> m (ByteString)
bufferGetData :: Buffer -> m ByteString
bufferGetData Buffer
buffer = IO ByteString -> m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ do
    Ptr Buffer
buffer' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
buffer
    Ptr (Ptr Word8)
data_ <- IO (Ptr (Ptr Word8))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Word8))
    Ptr Word64
length_ <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Buffer -> Ptr (Ptr Word8) -> Ptr Word64 -> IO ()
soup_buffer_get_data Ptr Buffer
buffer' Ptr (Ptr Word8)
data_ Ptr Word64
length_
    Word64
length_' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
length_
    Ptr Word8
data_' <- Ptr (Ptr Word8) -> IO (Ptr Word8)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Word8)
data_
    ByteString
data_'' <- (Word64 -> Ptr Word8 -> IO ByteString
forall a. Integral a => a -> Ptr Word8 -> IO ByteString
unpackByteStringWithLength Word64
length_') Ptr Word8
data_'
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    Ptr (Ptr Word8) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Word8)
data_
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
length_
    ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
data_''

#if defined(ENABLE_OVERLOADING)
data BufferGetDataMethodInfo
instance (signature ~ (m (ByteString)), MonadIO m) => O.MethodInfo BufferGetDataMethodInfo Buffer signature where
    overloadedMethod = bufferGetData

#endif

-- method Buffer::get_owner
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buffer"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Buffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #SoupBuffer created with soup_buffer_new_with_owner()"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TPtr)
-- throws : False
-- Skip return : False

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

-- | Gets the \"owner\" object for a buffer created with
-- 'GI.Soup.Structs.Buffer.bufferNewWithOwner'.
bufferGetOwner ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@buffer@/: a t'GI.Soup.Structs.Buffer.Buffer' created with 'GI.Soup.Structs.Buffer.bufferNewWithOwner'
    -> m (Ptr ())
    -- ^ __Returns:__ the owner pointer
bufferGetOwner :: Buffer -> m (Ptr ())
bufferGetOwner Buffer
buffer = IO (Ptr ()) -> m (Ptr ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr ()) -> m (Ptr ())) -> IO (Ptr ()) -> m (Ptr ())
forall a b. (a -> b) -> a -> b
$ do
    Ptr Buffer
buffer' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
buffer
    Ptr ()
result <- Ptr Buffer -> IO (Ptr ())
soup_buffer_get_owner Ptr Buffer
buffer'
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    Ptr () -> IO (Ptr ())
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ()
result

#if defined(ENABLE_OVERLOADING)
data BufferGetOwnerMethodInfo
instance (signature ~ (m (Ptr ())), MonadIO m) => O.MethodInfo BufferGetOwnerMethodInfo Buffer signature where
    overloadedMethod = bufferGetOwner

#endif

-- method Buffer::new_subbuffer
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "parent"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Buffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the parent #SoupBuffer"
--                 , 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 within @parent to start at"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of bytes to copy from @parent"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Soup" , name = "Buffer" })
-- throws : False
-- Skip return : False

foreign import ccall "soup_buffer_new_subbuffer" soup_buffer_new_subbuffer :: 
    Ptr Buffer ->                           -- parent : TInterface (Name {namespace = "Soup", name = "Buffer"})
    Word64 ->                               -- offset : TBasicType TUInt64
    Word64 ->                               -- length : TBasicType TUInt64
    IO (Ptr Buffer)

-- | Creates a new t'GI.Soup.Structs.Buffer.Buffer' containing /@length@/ bytes \"copied\" from
-- /@parent@/ starting at /@offset@/. (Normally this will not actually copy
-- any data, but will instead simply reference the same data as
-- /@parent@/ does.)
bufferNewSubbuffer ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Buffer
    -- ^ /@parent@/: the parent t'GI.Soup.Structs.Buffer.Buffer'
    -> Word64
    -- ^ /@offset@/: offset within /@parent@/ to start at
    -> Word64
    -- ^ /@length@/: number of bytes to copy from /@parent@/
    -> m Buffer
    -- ^ __Returns:__ the new t'GI.Soup.Structs.Buffer.Buffer'.
bufferNewSubbuffer :: Buffer -> Word64 -> Word64 -> m Buffer
bufferNewSubbuffer Buffer
parent Word64
offset Word64
length_ = IO Buffer -> m Buffer
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Buffer -> m Buffer) -> IO Buffer -> m Buffer
forall a b. (a -> b) -> a -> b
$ do
    Ptr Buffer
parent' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
parent
    Ptr Buffer
result <- Ptr Buffer -> Word64 -> Word64 -> IO (Ptr Buffer)
soup_buffer_new_subbuffer Ptr Buffer
parent' Word64
offset Word64
length_
    Text -> Ptr Buffer -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"bufferNewSubbuffer" Ptr Buffer
result
    Buffer
result' <- ((ManagedPtr Buffer -> Buffer) -> Ptr Buffer -> IO Buffer
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Buffer -> Buffer
Buffer) Ptr Buffer
result
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
parent
    Buffer -> IO Buffer
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer
result'

#if defined(ENABLE_OVERLOADING)
data BufferNewSubbufferMethodInfo
instance (signature ~ (Word64 -> Word64 -> m Buffer), MonadIO m) => O.MethodInfo BufferNewSubbufferMethodInfo Buffer signature where
    overloadedMethod = bufferNewSubbuffer

#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveBufferMethod (t :: Symbol) (o :: *) :: * where
    ResolveBufferMethod "copy" o = BufferCopyMethodInfo
    ResolveBufferMethod "free" o = BufferFreeMethodInfo
    ResolveBufferMethod "newSubbuffer" o = BufferNewSubbufferMethodInfo
    ResolveBufferMethod "getAsBytes" o = BufferGetAsBytesMethodInfo
    ResolveBufferMethod "getData" o = BufferGetDataMethodInfo
    ResolveBufferMethod "getOwner" o = BufferGetOwnerMethodInfo
    ResolveBufferMethod l o = O.MethodResolutionFailed l o

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

#endif