{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- t'GI.GstBase.Structs.BitWriter.BitWriter' provides a bit writer that can write any number of
-- bits into a memory buffer. It provides functions for writing any
-- number of bits into 8, 16, 32 and 64 bit variables.

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

module GI.GstBase.Structs.BitWriter
    ( 

-- * Exported types
    BitWriter(..)                           ,
    newZeroBitWriter                        ,
    noBitWriter                             ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveBitWriterMethod                  ,
#endif


-- ** alignBytes #method:alignBytes#

#if defined(ENABLE_OVERLOADING)
    BitWriterAlignBytesMethodInfo           ,
#endif
    bitWriterAlignBytes                     ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    BitWriterFreeMethodInfo                 ,
#endif
    bitWriterFree                           ,


-- ** freeAndGetBuffer #method:freeAndGetBuffer#

#if defined(ENABLE_OVERLOADING)
    BitWriterFreeAndGetBufferMethodInfo     ,
#endif
    bitWriterFreeAndGetBuffer               ,


-- ** getData #method:getData#

#if defined(ENABLE_OVERLOADING)
    BitWriterGetDataMethodInfo              ,
#endif
    bitWriterGetData                        ,


-- ** getRemaining #method:getRemaining#

#if defined(ENABLE_OVERLOADING)
    BitWriterGetRemainingMethodInfo         ,
#endif
    bitWriterGetRemaining                   ,


-- ** getSize #method:getSize#

#if defined(ENABLE_OVERLOADING)
    BitWriterGetSizeMethodInfo              ,
#endif
    bitWriterGetSize                        ,


-- ** putBitsUint16 #method:putBitsUint16#

#if defined(ENABLE_OVERLOADING)
    BitWriterPutBitsUint16MethodInfo        ,
#endif
    bitWriterPutBitsUint16                  ,


-- ** putBitsUint32 #method:putBitsUint32#

#if defined(ENABLE_OVERLOADING)
    BitWriterPutBitsUint32MethodInfo        ,
#endif
    bitWriterPutBitsUint32                  ,


-- ** putBitsUint64 #method:putBitsUint64#

#if defined(ENABLE_OVERLOADING)
    BitWriterPutBitsUint64MethodInfo        ,
#endif
    bitWriterPutBitsUint64                  ,


-- ** putBitsUint8 #method:putBitsUint8#

#if defined(ENABLE_OVERLOADING)
    BitWriterPutBitsUint8MethodInfo         ,
#endif
    bitWriterPutBitsUint8                   ,


-- ** putBytes #method:putBytes#

#if defined(ENABLE_OVERLOADING)
    BitWriterPutBytesMethodInfo             ,
#endif
    bitWriterPutBytes                       ,


-- ** reset #method:reset#

#if defined(ENABLE_OVERLOADING)
    BitWriterResetMethodInfo                ,
#endif
    bitWriterReset                          ,


-- ** resetAndGetBuffer #method:resetAndGetBuffer#

#if defined(ENABLE_OVERLOADING)
    BitWriterResetAndGetBufferMethodInfo    ,
#endif
    bitWriterResetAndGetBuffer              ,


-- ** setPos #method:setPos#

#if defined(ENABLE_OVERLOADING)
    BitWriterSetPosMethodInfo               ,
#endif
    bitWriterSetPos                         ,




 -- * Properties
-- ** bitSize #attr:bitSize#
-- | Size of written /@data@/ in bits

#if defined(ENABLE_OVERLOADING)
    bitWriter_bitSize                       ,
#endif
    getBitWriterBitSize                     ,
    setBitWriterBitSize                     ,


-- ** data #attr:data#
-- | Allocated /@data@/ for bit writer to write

#if defined(ENABLE_OVERLOADING)
    bitWriter_data                          ,
#endif
    getBitWriterData                        ,
    setBitWriterData                        ,




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.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 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.Gst.Structs.Buffer as Gst.Buffer

-- | Memory-managed wrapper type.
newtype BitWriter = BitWriter (ManagedPtr BitWriter)
    deriving (BitWriter -> BitWriter -> Bool
(BitWriter -> BitWriter -> Bool)
-> (BitWriter -> BitWriter -> Bool) -> Eq BitWriter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BitWriter -> BitWriter -> Bool
$c/= :: BitWriter -> BitWriter -> Bool
== :: BitWriter -> BitWriter -> Bool
$c== :: BitWriter -> BitWriter -> Bool
Eq)
instance WrappedPtr BitWriter where
    wrappedPtrCalloc :: IO (Ptr BitWriter)
wrappedPtrCalloc = Int -> IO (Ptr BitWriter)
forall a. Int -> IO (Ptr a)
callocBytes 56
    wrappedPtrCopy :: BitWriter -> IO BitWriter
wrappedPtrCopy = \p :: BitWriter
p -> BitWriter -> (Ptr BitWriter -> IO BitWriter) -> IO BitWriter
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr BitWriter
p (Int -> Ptr BitWriter -> IO (Ptr BitWriter)
forall a. WrappedPtr a => Int -> Ptr a -> IO (Ptr a)
copyBytes 56 (Ptr BitWriter -> IO (Ptr BitWriter))
-> (Ptr BitWriter -> IO BitWriter) -> Ptr BitWriter -> IO BitWriter
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (ManagedPtr BitWriter -> BitWriter)
-> Ptr BitWriter -> IO BitWriter
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr BitWriter -> BitWriter
BitWriter)
    wrappedPtrFree :: Maybe (GDestroyNotify BitWriter)
wrappedPtrFree = GDestroyNotify BitWriter -> Maybe (GDestroyNotify BitWriter)
forall a. a -> Maybe a
Just GDestroyNotify BitWriter
forall a. FunPtr (Ptr a -> IO ())
ptr_to_g_free

-- | Construct a `BitWriter` struct initialized to zero.
newZeroBitWriter :: MonadIO m => m BitWriter
newZeroBitWriter :: m BitWriter
newZeroBitWriter = IO BitWriter -> m BitWriter
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BitWriter -> m BitWriter) -> IO BitWriter -> m BitWriter
forall a b. (a -> b) -> a -> b
$ IO (Ptr BitWriter)
forall a. WrappedPtr a => IO (Ptr a)
wrappedPtrCalloc IO (Ptr BitWriter)
-> (Ptr BitWriter -> IO BitWriter) -> IO BitWriter
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr BitWriter -> BitWriter)
-> Ptr BitWriter -> IO BitWriter
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr BitWriter -> BitWriter
BitWriter

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


-- | A convenience alias for `Nothing` :: `Maybe` `BitWriter`.
noBitWriter :: Maybe BitWriter
noBitWriter :: Maybe BitWriter
noBitWriter = Maybe BitWriter
forall a. Maybe a
Nothing

-- | 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' bitWriter #data
-- @
getBitWriterData :: MonadIO m => BitWriter -> m Word8
getBitWriterData :: BitWriter -> m Word8
getBitWriterData s :: BitWriter
s = IO Word8 -> m Word8
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
$ BitWriter -> (Ptr BitWriter -> IO Word8) -> IO Word8
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr BitWriter
s ((Ptr BitWriter -> IO Word8) -> IO Word8)
-> (Ptr BitWriter -> IO Word8) -> IO Word8
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr BitWriter
ptr -> do
    Word8
val <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek (Ptr BitWriter
ptr Ptr BitWriter -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0) :: IO Word8
    Word8 -> IO Word8
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' bitWriter [ #data 'Data.GI.Base.Attributes.:=' value ]
-- @
setBitWriterData :: MonadIO m => BitWriter -> Word8 -> m ()
setBitWriterData :: BitWriter -> Word8 -> m ()
setBitWriterData s :: BitWriter
s val :: Word8
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ BitWriter -> (Ptr BitWriter -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr BitWriter
s ((Ptr BitWriter -> IO ()) -> IO ())
-> (Ptr BitWriter -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr BitWriter
ptr -> do
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr BitWriter
ptr Ptr BitWriter -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0) (Word8
val :: Word8)

#if defined(ENABLE_OVERLOADING)
data BitWriterDataFieldInfo
instance AttrInfo BitWriterDataFieldInfo where
    type AttrBaseTypeConstraint BitWriterDataFieldInfo = (~) BitWriter
    type AttrAllowedOps BitWriterDataFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint BitWriterDataFieldInfo = (~) Word8
    type AttrTransferTypeConstraint BitWriterDataFieldInfo = (~)Word8
    type AttrTransferType BitWriterDataFieldInfo = Word8
    type AttrGetType BitWriterDataFieldInfo = Word8
    type AttrLabel BitWriterDataFieldInfo = "data"
    type AttrOrigin BitWriterDataFieldInfo = BitWriter
    attrGet = getBitWriterData
    attrSet = setBitWriterData
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

bitWriter_data :: AttrLabelProxy "data"
bitWriter_data = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data BitWriterBitSizeFieldInfo
instance AttrInfo BitWriterBitSizeFieldInfo where
    type AttrBaseTypeConstraint BitWriterBitSizeFieldInfo = (~) BitWriter
    type AttrAllowedOps BitWriterBitSizeFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint BitWriterBitSizeFieldInfo = (~) Word32
    type AttrTransferTypeConstraint BitWriterBitSizeFieldInfo = (~)Word32
    type AttrTransferType BitWriterBitSizeFieldInfo = Word32
    type AttrGetType BitWriterBitSizeFieldInfo = Word32
    type AttrLabel BitWriterBitSizeFieldInfo = "bit_size"
    type AttrOrigin BitWriterBitSizeFieldInfo = BitWriter
    attrGet = getBitWriterBitSize
    attrSet = setBitWriterBitSize
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

bitWriter_bitSize :: AttrLabelProxy "bitSize"
bitWriter_bitSize = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList BitWriter
type instance O.AttributeList BitWriter = BitWriterAttributeList
type BitWriterAttributeList = ('[ '("data", BitWriterDataFieldInfo), '("bitSize", BitWriterBitSizeFieldInfo)] :: [(Symbol, *)])
#endif

-- method BitWriter::align_bytes
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bitwriter"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BitWriter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBitWriter instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "trailing_bit"
--           , argType = TBasicType TUInt8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "trailing bits of last byte, 0 or 1"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_bit_writer_align_bytes" gst_bit_writer_align_bytes :: 
    Ptr BitWriter ->                        -- bitwriter : TInterface (Name {namespace = "GstBase", name = "BitWriter"})
    Word8 ->                                -- trailing_bit : TBasicType TUInt8
    IO CInt

-- | Write trailing bit to align last byte of /@data@/. /@trailingBit@/ can
-- only be 1 or 0.
bitWriterAlignBytes ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BitWriter
    -- ^ /@bitwriter@/: a t'GI.GstBase.Structs.BitWriter.BitWriter' instance
    -> Word8
    -- ^ /@trailingBit@/: trailing bits of last byte, 0 or 1
    -> m Bool
    -- ^ __Returns:__ 'P.True' if successful, 'P.False' otherwise.
bitWriterAlignBytes :: BitWriter -> Word8 -> m Bool
bitWriterAlignBytes bitwriter :: BitWriter
bitwriter trailingBit :: Word8
trailingBit = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr BitWriter
bitwriter' <- BitWriter -> IO (Ptr BitWriter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BitWriter
bitwriter
    CInt
result <- Ptr BitWriter -> Word8 -> IO CInt
gst_bit_writer_align_bytes Ptr BitWriter
bitwriter' Word8
trailingBit
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    BitWriter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BitWriter
bitwriter
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BitWriterAlignBytesMethodInfo
instance (signature ~ (Word8 -> m Bool), MonadIO m) => O.MethodInfo BitWriterAlignBytesMethodInfo BitWriter signature where
    overloadedMethod = bitWriterAlignBytes

#endif

-- method BitWriter::free
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bitwriter"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BitWriter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GstBitWriter instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_bit_writer_free" gst_bit_writer_free :: 
    Ptr BitWriter ->                        -- bitwriter : TInterface (Name {namespace = "GstBase", name = "BitWriter"})
    IO ()

-- | Frees /@bitwriter@/ and the allocated data inside.
bitWriterFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BitWriter
    -- ^ /@bitwriter@/: t'GI.GstBase.Structs.BitWriter.BitWriter' instance
    -> m ()
bitWriterFree :: BitWriter -> m ()
bitWriterFree bitwriter :: BitWriter
bitwriter = 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 BitWriter
bitwriter' <- BitWriter -> IO (Ptr BitWriter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BitWriter
bitwriter
    Ptr BitWriter -> IO ()
gst_bit_writer_free Ptr BitWriter
bitwriter'
    BitWriter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BitWriter
bitwriter
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BitWriterFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo BitWriterFreeMethodInfo BitWriter signature where
    overloadedMethod = bitWriterFree

#endif

-- method BitWriter::free_and_get_buffer
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bitwriter"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BitWriter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GstBitWriter instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Buffer" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_bit_writer_free_and_get_buffer" gst_bit_writer_free_and_get_buffer :: 
    Ptr BitWriter ->                        -- bitwriter : TInterface (Name {namespace = "GstBase", name = "BitWriter"})
    IO (Ptr Gst.Buffer.Buffer)

-- | Frees /@bitwriter@/ without destroying the internal data, which is
-- returned as t'GI.Gst.Structs.Buffer.Buffer'.
-- 
-- Free-function: gst_buffer_unref
bitWriterFreeAndGetBuffer ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BitWriter
    -- ^ /@bitwriter@/: t'GI.GstBase.Structs.BitWriter.BitWriter' instance
    -> m Gst.Buffer.Buffer
    -- ^ __Returns:__ a new allocated t'GI.Gst.Structs.Buffer.Buffer' wrapping the
    --     data inside. @/gst_buffer_unref()/@ after usage.
bitWriterFreeAndGetBuffer :: BitWriter -> m Buffer
bitWriterFreeAndGetBuffer bitwriter :: BitWriter
bitwriter = 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 BitWriter
bitwriter' <- BitWriter -> IO (Ptr BitWriter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BitWriter
bitwriter
    Ptr Buffer
result <- Ptr BitWriter -> IO (Ptr Buffer)
gst_bit_writer_free_and_get_buffer Ptr BitWriter
bitwriter'
    Text -> Ptr Buffer -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "bitWriterFreeAndGetBuffer" Ptr Buffer
result
    Buffer
result' <- ((ManagedPtr Buffer -> Buffer) -> Ptr Buffer -> IO Buffer
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Buffer -> Buffer
Gst.Buffer.Buffer) Ptr Buffer
result
    BitWriter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BitWriter
bitwriter
    Buffer -> IO Buffer
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer
result'

#if defined(ENABLE_OVERLOADING)
data BitWriterFreeAndGetBufferMethodInfo
instance (signature ~ (m Gst.Buffer.Buffer), MonadIO m) => O.MethodInfo BitWriterFreeAndGetBufferMethodInfo BitWriter signature where
    overloadedMethod = bitWriterFreeAndGetBuffer

#endif

-- XXX Could not generate method BitWriter::free_and_get_data
-- Error was : Bad introspection data: "`TCArray False (-1) (-1) (TBasicType TUInt8)' is an array type, but contains no length information,\nso it cannot be unpacked."
-- method BitWriter::get_data
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bitwriter"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BitWriter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBitWriter instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt8)
-- throws : False
-- Skip return : False

foreign import ccall "gst_bit_writer_get_data" gst_bit_writer_get_data :: 
    Ptr BitWriter ->                        -- bitwriter : TInterface (Name {namespace = "GstBase", name = "BitWriter"})
    IO Word8

-- | Get written data pointer
bitWriterGetData ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BitWriter
    -- ^ /@bitwriter@/: a t'GI.GstBase.Structs.BitWriter.BitWriter' instance
    -> m Word8
    -- ^ __Returns:__ data pointer
bitWriterGetData :: BitWriter -> m Word8
bitWriterGetData bitwriter :: BitWriter
bitwriter = IO Word8 -> m Word8
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 BitWriter
bitwriter' <- BitWriter -> IO (Ptr BitWriter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BitWriter
bitwriter
    Word8
result <- Ptr BitWriter -> IO Word8
gst_bit_writer_get_data Ptr BitWriter
bitwriter'
    BitWriter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BitWriter
bitwriter
    Word8 -> IO Word8
forall (m :: * -> *) a. Monad m => a -> m a
return Word8
result

#if defined(ENABLE_OVERLOADING)
data BitWriterGetDataMethodInfo
instance (signature ~ (m Word8), MonadIO m) => O.MethodInfo BitWriterGetDataMethodInfo BitWriter signature where
    overloadedMethod = bitWriterGetData

#endif

-- method BitWriter::get_remaining
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bitwriter"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BitWriter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "gst_bit_writer_get_remaining" gst_bit_writer_get_remaining :: 
    Ptr BitWriter ->                        -- bitwriter : TInterface (Name {namespace = "GstBase", name = "BitWriter"})
    IO Word32

-- | /No description available in the introspection data./
bitWriterGetRemaining ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BitWriter
    -> m Word32
bitWriterGetRemaining :: BitWriter -> m Word32
bitWriterGetRemaining bitwriter :: BitWriter
bitwriter = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr BitWriter
bitwriter' <- BitWriter -> IO (Ptr BitWriter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BitWriter
bitwriter
    Word32
result <- Ptr BitWriter -> IO Word32
gst_bit_writer_get_remaining Ptr BitWriter
bitwriter'
    BitWriter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BitWriter
bitwriter
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data BitWriterGetRemainingMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.MethodInfo BitWriterGetRemainingMethodInfo BitWriter signature where
    overloadedMethod = bitWriterGetRemaining

#endif

-- method BitWriter::get_size
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bitwriter"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BitWriter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBitWriter instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "gst_bit_writer_get_size" gst_bit_writer_get_size :: 
    Ptr BitWriter ->                        -- bitwriter : TInterface (Name {namespace = "GstBase", name = "BitWriter"})
    IO Word32

-- | Get size of written /@data@/
bitWriterGetSize ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BitWriter
    -- ^ /@bitwriter@/: a t'GI.GstBase.Structs.BitWriter.BitWriter' instance
    -> m Word32
    -- ^ __Returns:__ size of bits written in /@data@/
bitWriterGetSize :: BitWriter -> m Word32
bitWriterGetSize bitwriter :: BitWriter
bitwriter = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr BitWriter
bitwriter' <- BitWriter -> IO (Ptr BitWriter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BitWriter
bitwriter
    Word32
result <- Ptr BitWriter -> IO Word32
gst_bit_writer_get_size Ptr BitWriter
bitwriter'
    BitWriter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BitWriter
bitwriter
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data BitWriterGetSizeMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.MethodInfo BitWriterGetSizeMethodInfo BitWriter signature where
    overloadedMethod = bitWriterGetSize

#endif

-- method BitWriter::put_bits_uint16
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bitwriter"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BitWriter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBitWriter instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TUInt16
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "value of #guint16 to write"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "nbits"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of bits to write"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_bit_writer_put_bits_uint16" gst_bit_writer_put_bits_uint16 :: 
    Ptr BitWriter ->                        -- bitwriter : TInterface (Name {namespace = "GstBase", name = "BitWriter"})
    Word16 ->                               -- value : TBasicType TUInt16
    Word32 ->                               -- nbits : TBasicType TUInt
    IO CInt

-- | Write /@nbits@/ bits of /@value@/ to t'GI.GstBase.Structs.BitWriter.BitWriter'.
bitWriterPutBitsUint16 ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BitWriter
    -- ^ /@bitwriter@/: a t'GI.GstBase.Structs.BitWriter.BitWriter' instance
    -> Word16
    -- ^ /@value@/: value of @/guint16/@ to write
    -> Word32
    -- ^ /@nbits@/: number of bits to write
    -> m Bool
    -- ^ __Returns:__ 'P.True' if successful, 'P.False' otherwise.
bitWriterPutBitsUint16 :: BitWriter -> Word16 -> Word32 -> m Bool
bitWriterPutBitsUint16 bitwriter :: BitWriter
bitwriter value :: Word16
value nbits :: Word32
nbits = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr BitWriter
bitwriter' <- BitWriter -> IO (Ptr BitWriter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BitWriter
bitwriter
    CInt
result <- Ptr BitWriter -> Word16 -> Word32 -> IO CInt
gst_bit_writer_put_bits_uint16 Ptr BitWriter
bitwriter' Word16
value Word32
nbits
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    BitWriter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BitWriter
bitwriter
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BitWriterPutBitsUint16MethodInfo
instance (signature ~ (Word16 -> Word32 -> m Bool), MonadIO m) => O.MethodInfo BitWriterPutBitsUint16MethodInfo BitWriter signature where
    overloadedMethod = bitWriterPutBitsUint16

#endif

-- method BitWriter::put_bits_uint32
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bitwriter"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BitWriter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBitWriter instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TUInt32
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "value of #guint32 to write"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "nbits"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of bits to write"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_bit_writer_put_bits_uint32" gst_bit_writer_put_bits_uint32 :: 
    Ptr BitWriter ->                        -- bitwriter : TInterface (Name {namespace = "GstBase", name = "BitWriter"})
    Word32 ->                               -- value : TBasicType TUInt32
    Word32 ->                               -- nbits : TBasicType TUInt
    IO CInt

-- | Write /@nbits@/ bits of /@value@/ to t'GI.GstBase.Structs.BitWriter.BitWriter'.
bitWriterPutBitsUint32 ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BitWriter
    -- ^ /@bitwriter@/: a t'GI.GstBase.Structs.BitWriter.BitWriter' instance
    -> Word32
    -- ^ /@value@/: value of @/guint32/@ to write
    -> Word32
    -- ^ /@nbits@/: number of bits to write
    -> m Bool
    -- ^ __Returns:__ 'P.True' if successful, 'P.False' otherwise.
bitWriterPutBitsUint32 :: BitWriter -> Word32 -> Word32 -> m Bool
bitWriterPutBitsUint32 bitwriter :: BitWriter
bitwriter value :: Word32
value nbits :: Word32
nbits = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr BitWriter
bitwriter' <- BitWriter -> IO (Ptr BitWriter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BitWriter
bitwriter
    CInt
result <- Ptr BitWriter -> Word32 -> Word32 -> IO CInt
gst_bit_writer_put_bits_uint32 Ptr BitWriter
bitwriter' Word32
value Word32
nbits
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    BitWriter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BitWriter
bitwriter
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BitWriterPutBitsUint32MethodInfo
instance (signature ~ (Word32 -> Word32 -> m Bool), MonadIO m) => O.MethodInfo BitWriterPutBitsUint32MethodInfo BitWriter signature where
    overloadedMethod = bitWriterPutBitsUint32

#endif

-- method BitWriter::put_bits_uint64
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bitwriter"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BitWriter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBitWriter instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "value of #guint64 to write"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "nbits"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of bits to write"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_bit_writer_put_bits_uint64" gst_bit_writer_put_bits_uint64 :: 
    Ptr BitWriter ->                        -- bitwriter : TInterface (Name {namespace = "GstBase", name = "BitWriter"})
    Word64 ->                               -- value : TBasicType TUInt64
    Word32 ->                               -- nbits : TBasicType TUInt
    IO CInt

-- | Write /@nbits@/ bits of /@value@/ to t'GI.GstBase.Structs.BitWriter.BitWriter'.
bitWriterPutBitsUint64 ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BitWriter
    -- ^ /@bitwriter@/: a t'GI.GstBase.Structs.BitWriter.BitWriter' instance
    -> Word64
    -- ^ /@value@/: value of @/guint64/@ to write
    -> Word32
    -- ^ /@nbits@/: number of bits to write
    -> m Bool
    -- ^ __Returns:__ 'P.True' if successful, 'P.False' otherwise.
bitWriterPutBitsUint64 :: BitWriter -> Word64 -> Word32 -> m Bool
bitWriterPutBitsUint64 bitwriter :: BitWriter
bitwriter value :: Word64
value nbits :: Word32
nbits = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr BitWriter
bitwriter' <- BitWriter -> IO (Ptr BitWriter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BitWriter
bitwriter
    CInt
result <- Ptr BitWriter -> Word64 -> Word32 -> IO CInt
gst_bit_writer_put_bits_uint64 Ptr BitWriter
bitwriter' Word64
value Word32
nbits
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    BitWriter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BitWriter
bitwriter
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BitWriterPutBitsUint64MethodInfo
instance (signature ~ (Word64 -> Word32 -> m Bool), MonadIO m) => O.MethodInfo BitWriterPutBitsUint64MethodInfo BitWriter signature where
    overloadedMethod = bitWriterPutBitsUint64

#endif

-- method BitWriter::put_bits_uint8
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bitwriter"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BitWriter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBitWriter instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TUInt8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "value of #guint8 to write"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "nbits"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of bits to write"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_bit_writer_put_bits_uint8" gst_bit_writer_put_bits_uint8 :: 
    Ptr BitWriter ->                        -- bitwriter : TInterface (Name {namespace = "GstBase", name = "BitWriter"})
    Word8 ->                                -- value : TBasicType TUInt8
    Word32 ->                               -- nbits : TBasicType TUInt
    IO CInt

-- | Write /@nbits@/ bits of /@value@/ to t'GI.GstBase.Structs.BitWriter.BitWriter'.
bitWriterPutBitsUint8 ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BitWriter
    -- ^ /@bitwriter@/: a t'GI.GstBase.Structs.BitWriter.BitWriter' instance
    -> Word8
    -- ^ /@value@/: value of @/guint8/@ to write
    -> Word32
    -- ^ /@nbits@/: number of bits to write
    -> m Bool
    -- ^ __Returns:__ 'P.True' if successful, 'P.False' otherwise.
bitWriterPutBitsUint8 :: BitWriter -> Word8 -> Word32 -> m Bool
bitWriterPutBitsUint8 bitwriter :: BitWriter
bitwriter value :: Word8
value nbits :: Word32
nbits = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr BitWriter
bitwriter' <- BitWriter -> IO (Ptr BitWriter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BitWriter
bitwriter
    CInt
result <- Ptr BitWriter -> Word8 -> Word32 -> IO CInt
gst_bit_writer_put_bits_uint8 Ptr BitWriter
bitwriter' Word8
value Word32
nbits
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    BitWriter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BitWriter
bitwriter
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BitWriterPutBitsUint8MethodInfo
instance (signature ~ (Word8 -> Word32 -> m Bool), MonadIO m) => O.MethodInfo BitWriterPutBitsUint8MethodInfo BitWriter signature where
    overloadedMethod = bitWriterPutBitsUint8

#endif

-- method BitWriter::put_bytes
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bitwriter"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BitWriter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBitWriter instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TBasicType TUInt8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "pointer of data to write"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "nbytes"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of bytes to write"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_bit_writer_put_bytes" gst_bit_writer_put_bytes :: 
    Ptr BitWriter ->                        -- bitwriter : TInterface (Name {namespace = "GstBase", name = "BitWriter"})
    Word8 ->                                -- data : TBasicType TUInt8
    Word32 ->                               -- nbytes : TBasicType TUInt
    IO CInt

-- | Write /@nbytes@/ bytes of /@data@/ to t'GI.GstBase.Structs.BitWriter.BitWriter'.
bitWriterPutBytes ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BitWriter
    -- ^ /@bitwriter@/: a t'GI.GstBase.Structs.BitWriter.BitWriter' instance
    -> Word8
    -- ^ /@data@/: pointer of data to write
    -> Word32
    -- ^ /@nbytes@/: number of bytes to write
    -> m Bool
    -- ^ __Returns:__ 'P.True' if successful, 'P.False' otherwise.
bitWriterPutBytes :: BitWriter -> Word8 -> Word32 -> m Bool
bitWriterPutBytes bitwriter :: BitWriter
bitwriter data_ :: Word8
data_ nbytes :: Word32
nbytes = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr BitWriter
bitwriter' <- BitWriter -> IO (Ptr BitWriter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BitWriter
bitwriter
    CInt
result <- Ptr BitWriter -> Word8 -> Word32 -> IO CInt
gst_bit_writer_put_bytes Ptr BitWriter
bitwriter' Word8
data_ Word32
nbytes
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    BitWriter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BitWriter
bitwriter
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BitWriterPutBytesMethodInfo
instance (signature ~ (Word8 -> Word32 -> m Bool), MonadIO m) => O.MethodInfo BitWriterPutBytesMethodInfo BitWriter signature where
    overloadedMethod = bitWriterPutBytes

#endif

-- method BitWriter::reset
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bitwriter"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BitWriter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GstBitWriter instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_bit_writer_reset" gst_bit_writer_reset :: 
    Ptr BitWriter ->                        -- bitwriter : TInterface (Name {namespace = "GstBase", name = "BitWriter"})
    IO ()

-- | Resets /@bitwriter@/ and frees the data if it\'s owned by /@bitwriter@/.
bitWriterReset ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BitWriter
    -- ^ /@bitwriter@/: t'GI.GstBase.Structs.BitWriter.BitWriter' instance
    -> m ()
bitWriterReset :: BitWriter -> m ()
bitWriterReset bitwriter :: BitWriter
bitwriter = 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 BitWriter
bitwriter' <- BitWriter -> IO (Ptr BitWriter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BitWriter
bitwriter
    Ptr BitWriter -> IO ()
gst_bit_writer_reset Ptr BitWriter
bitwriter'
    BitWriter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BitWriter
bitwriter
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BitWriterResetMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo BitWriterResetMethodInfo BitWriter signature where
    overloadedMethod = bitWriterReset

#endif

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

foreign import ccall "gst_bit_writer_reset_and_get_buffer" gst_bit_writer_reset_and_get_buffer :: 
    Ptr BitWriter ->                        -- bitwriter : TInterface (Name {namespace = "GstBase", name = "BitWriter"})
    IO (Ptr Gst.Buffer.Buffer)

-- | Resets /@bitwriter@/ and returns the current data as t'GI.Gst.Structs.Buffer.Buffer'.
-- 
-- Free-function: gst_buffer_unref
bitWriterResetAndGetBuffer ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BitWriter
    -- ^ /@bitwriter@/: a t'GI.GstBase.Structs.BitWriter.BitWriter' instance
    -> m Gst.Buffer.Buffer
    -- ^ __Returns:__ a new allocated t'GI.Gst.Structs.Buffer.Buffer' wrapping the
    --     current data. @/gst_buffer_unref()/@ after usage.
bitWriterResetAndGetBuffer :: BitWriter -> m Buffer
bitWriterResetAndGetBuffer bitwriter :: BitWriter
bitwriter = 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 BitWriter
bitwriter' <- BitWriter -> IO (Ptr BitWriter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BitWriter
bitwriter
    Ptr Buffer
result <- Ptr BitWriter -> IO (Ptr Buffer)
gst_bit_writer_reset_and_get_buffer Ptr BitWriter
bitwriter'
    Text -> Ptr Buffer -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "bitWriterResetAndGetBuffer" Ptr Buffer
result
    Buffer
result' <- ((ManagedPtr Buffer -> Buffer) -> Ptr Buffer -> IO Buffer
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Buffer -> Buffer
Gst.Buffer.Buffer) Ptr Buffer
result
    BitWriter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BitWriter
bitwriter
    Buffer -> IO Buffer
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer
result'

#if defined(ENABLE_OVERLOADING)
data BitWriterResetAndGetBufferMethodInfo
instance (signature ~ (m Gst.Buffer.Buffer), MonadIO m) => O.MethodInfo BitWriterResetAndGetBufferMethodInfo BitWriter signature where
    overloadedMethod = bitWriterResetAndGetBuffer

#endif

-- XXX Could not generate method BitWriter::reset_and_get_data
-- Error was : Bad introspection data: "`TCArray False (-1) (-1) (TBasicType TUInt8)' is an array type, but contains no length information,\nso it cannot be unpacked."
-- method BitWriter::set_pos
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bitwriter"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BitWriter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "pos"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_bit_writer_set_pos" gst_bit_writer_set_pos :: 
    Ptr BitWriter ->                        -- bitwriter : TInterface (Name {namespace = "GstBase", name = "BitWriter"})
    Word32 ->                               -- pos : TBasicType TUInt
    IO CInt

-- | /No description available in the introspection data./
bitWriterSetPos ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BitWriter
    -> Word32
    -> m Bool
bitWriterSetPos :: BitWriter -> Word32 -> m Bool
bitWriterSetPos bitwriter :: BitWriter
bitwriter pos :: Word32
pos = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr BitWriter
bitwriter' <- BitWriter -> IO (Ptr BitWriter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BitWriter
bitwriter
    CInt
result <- Ptr BitWriter -> Word32 -> IO CInt
gst_bit_writer_set_pos Ptr BitWriter
bitwriter' Word32
pos
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    BitWriter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BitWriter
bitwriter
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BitWriterSetPosMethodInfo
instance (signature ~ (Word32 -> m Bool), MonadIO m) => O.MethodInfo BitWriterSetPosMethodInfo BitWriter signature where
    overloadedMethod = bitWriterSetPos

#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveBitWriterMethod (t :: Symbol) (o :: *) :: * where
    ResolveBitWriterMethod "alignBytes" o = BitWriterAlignBytesMethodInfo
    ResolveBitWriterMethod "free" o = BitWriterFreeMethodInfo
    ResolveBitWriterMethod "freeAndGetBuffer" o = BitWriterFreeAndGetBufferMethodInfo
    ResolveBitWriterMethod "putBitsUint16" o = BitWriterPutBitsUint16MethodInfo
    ResolveBitWriterMethod "putBitsUint32" o = BitWriterPutBitsUint32MethodInfo
    ResolveBitWriterMethod "putBitsUint64" o = BitWriterPutBitsUint64MethodInfo
    ResolveBitWriterMethod "putBitsUint8" o = BitWriterPutBitsUint8MethodInfo
    ResolveBitWriterMethod "putBytes" o = BitWriterPutBytesMethodInfo
    ResolveBitWriterMethod "reset" o = BitWriterResetMethodInfo
    ResolveBitWriterMethod "resetAndGetBuffer" o = BitWriterResetAndGetBufferMethodInfo
    ResolveBitWriterMethod "getData" o = BitWriterGetDataMethodInfo
    ResolveBitWriterMethod "getRemaining" o = BitWriterGetRemainingMethodInfo
    ResolveBitWriterMethod "getSize" o = BitWriterGetSizeMethodInfo
    ResolveBitWriterMethod "setPos" o = BitWriterSetPosMethodInfo
    ResolveBitWriterMethod l o = O.MethodResolutionFailed l o

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

#endif