{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- t'GI.GstBase.Structs.BitReader.BitReader' provides a bit reader that can read any number of bits
-- from a memory buffer. It provides functions for reading 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.BitReader
    ( 

-- * Exported types
    BitReader(..)                           ,
    newZeroBitReader                        ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [free]("GI.GstBase.Structs.BitReader#g:method:free"), [init]("GI.GstBase.Structs.BitReader#g:method:init"), [peekBitsUint16]("GI.GstBase.Structs.BitReader#g:method:peekBitsUint16"), [peekBitsUint32]("GI.GstBase.Structs.BitReader#g:method:peekBitsUint32"), [peekBitsUint64]("GI.GstBase.Structs.BitReader#g:method:peekBitsUint64"), [peekBitsUint8]("GI.GstBase.Structs.BitReader#g:method:peekBitsUint8"), [skip]("GI.GstBase.Structs.BitReader#g:method:skip"), [skipToByte]("GI.GstBase.Structs.BitReader#g:method:skipToByte").
-- 
-- ==== Getters
-- [getBitsUint16]("GI.GstBase.Structs.BitReader#g:method:getBitsUint16"), [getBitsUint32]("GI.GstBase.Structs.BitReader#g:method:getBitsUint32"), [getBitsUint64]("GI.GstBase.Structs.BitReader#g:method:getBitsUint64"), [getBitsUint8]("GI.GstBase.Structs.BitReader#g:method:getBitsUint8"), [getPos]("GI.GstBase.Structs.BitReader#g:method:getPos"), [getRemaining]("GI.GstBase.Structs.BitReader#g:method:getRemaining"), [getSize]("GI.GstBase.Structs.BitReader#g:method:getSize").
-- 
-- ==== Setters
-- [setPos]("GI.GstBase.Structs.BitReader#g:method:setPos").

#if defined(ENABLE_OVERLOADING)
    ResolveBitReaderMethod                  ,
#endif

-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    BitReaderFreeMethodInfo                 ,
#endif
    bitReaderFree                           ,


-- ** getBitsUint16 #method:getBitsUint16#

#if defined(ENABLE_OVERLOADING)
    BitReaderGetBitsUint16MethodInfo        ,
#endif
    bitReaderGetBitsUint16                  ,


-- ** getBitsUint32 #method:getBitsUint32#

#if defined(ENABLE_OVERLOADING)
    BitReaderGetBitsUint32MethodInfo        ,
#endif
    bitReaderGetBitsUint32                  ,


-- ** getBitsUint64 #method:getBitsUint64#

#if defined(ENABLE_OVERLOADING)
    BitReaderGetBitsUint64MethodInfo        ,
#endif
    bitReaderGetBitsUint64                  ,


-- ** getBitsUint8 #method:getBitsUint8#

#if defined(ENABLE_OVERLOADING)
    BitReaderGetBitsUint8MethodInfo         ,
#endif
    bitReaderGetBitsUint8                   ,


-- ** getPos #method:getPos#

#if defined(ENABLE_OVERLOADING)
    BitReaderGetPosMethodInfo               ,
#endif
    bitReaderGetPos                         ,


-- ** getRemaining #method:getRemaining#

#if defined(ENABLE_OVERLOADING)
    BitReaderGetRemainingMethodInfo         ,
#endif
    bitReaderGetRemaining                   ,


-- ** getSize #method:getSize#

#if defined(ENABLE_OVERLOADING)
    BitReaderGetSizeMethodInfo              ,
#endif
    bitReaderGetSize                        ,


-- ** init #method:init#

#if defined(ENABLE_OVERLOADING)
    BitReaderInitMethodInfo                 ,
#endif
    bitReaderInit                           ,


-- ** peekBitsUint16 #method:peekBitsUint16#

#if defined(ENABLE_OVERLOADING)
    BitReaderPeekBitsUint16MethodInfo       ,
#endif
    bitReaderPeekBitsUint16                 ,


-- ** peekBitsUint32 #method:peekBitsUint32#

#if defined(ENABLE_OVERLOADING)
    BitReaderPeekBitsUint32MethodInfo       ,
#endif
    bitReaderPeekBitsUint32                 ,


-- ** peekBitsUint64 #method:peekBitsUint64#

#if defined(ENABLE_OVERLOADING)
    BitReaderPeekBitsUint64MethodInfo       ,
#endif
    bitReaderPeekBitsUint64                 ,


-- ** peekBitsUint8 #method:peekBitsUint8#

#if defined(ENABLE_OVERLOADING)
    BitReaderPeekBitsUint8MethodInfo        ,
#endif
    bitReaderPeekBitsUint8                  ,


-- ** setPos #method:setPos#

#if defined(ENABLE_OVERLOADING)
    BitReaderSetPosMethodInfo               ,
#endif
    bitReaderSetPos                         ,


-- ** skip #method:skip#

#if defined(ENABLE_OVERLOADING)
    BitReaderSkipMethodInfo                 ,
#endif
    bitReaderSkip                           ,


-- ** skipToByte #method:skipToByte#

#if defined(ENABLE_OVERLOADING)
    BitReaderSkipToByteMethodInfo           ,
#endif
    bitReaderSkipToByte                     ,




 -- * Properties


-- ** bit #attr:bit#
-- | Bit position in the current byte

#if defined(ENABLE_OVERLOADING)
    bitReader_bit                           ,
#endif
    getBitReaderBit                         ,
    setBitReaderBit                         ,


-- ** byte #attr:byte#
-- | Current byte position

#if defined(ENABLE_OVERLOADING)
    bitReader_byte                          ,
#endif
    getBitReaderByte                        ,
    setBitReaderByte                        ,


-- ** size #attr:size#
-- | Size of /@data@/ in bytes

#if defined(ENABLE_OVERLOADING)
    bitReader_size                          ,
#endif
    getBitReaderSize                        ,
    setBitReaderSize                        ,




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R


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

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

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


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

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


-- XXX Skipped attribute for "BitReader:data"
-- Not implemented: Don't know how to unpack C array of type TCArray False (-1) 1 (TBasicType TUInt8)
-- | Get the value of the “@size@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' bitReader #size
-- @
getBitReaderSize :: MonadIO m => BitReader -> m Word32
getBitReaderSize :: forall (m :: * -> *). MonadIO m => BitReader -> m Word32
getBitReaderSize BitReader
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
$ BitReader -> (Ptr BitReader -> IO Word32) -> IO Word32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr BitReader
s ((Ptr BitReader -> IO Word32) -> IO Word32)
-> (Ptr BitReader -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ \Ptr BitReader
ptr -> do
    Word32
val <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek (Ptr BitReader
ptr Ptr BitReader -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) :: IO Word32
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
val

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

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

bitReader_size :: AttrLabelProxy "size"
bitReader_size = AttrLabelProxy

#endif


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

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

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

bitReader_byte :: AttrLabelProxy "byte"
bitReader_byte = AttrLabelProxy

#endif


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

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

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

bitReader_bit :: AttrLabelProxy "bit"
bitReader_bit = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList BitReader
type instance O.AttributeList BitReader = BitReaderAttributeList
type BitReaderAttributeList = ('[ '("size", BitReaderSizeFieldInfo), '("byte", BitReaderByteFieldInfo), '("bit", BitReaderBitFieldInfo)] :: [(Symbol, *)])
#endif

-- method BitReader::free
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "reader"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BitReader" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBitReader 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_reader_free" gst_bit_reader_free :: 
    Ptr BitReader ->                        -- reader : TInterface (Name {namespace = "GstBase", name = "BitReader"})
    IO ()

-- | Frees a t'GI.GstBase.Structs.BitReader.BitReader' instance, which was previously allocated by
-- @/gst_bit_reader_new()/@.
bitReaderFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BitReader
    -- ^ /@reader@/: a t'GI.GstBase.Structs.BitReader.BitReader' instance
    -> m ()
bitReaderFree :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BitReader -> m ()
bitReaderFree BitReader
reader = 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 BitReader
reader' <- BitReader -> IO (Ptr BitReader)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BitReader
reader
    Ptr BitReader -> IO ()
gst_bit_reader_free Ptr BitReader
reader'
    BitReader -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BitReader
reader
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BitReaderFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod BitReaderFreeMethodInfo BitReader signature where
    overloadedMethod = bitReaderFree

instance O.OverloadedMethodInfo BitReaderFreeMethodInfo BitReader where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstBase.Structs.BitReader.bitReaderFree",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstbase-1.0.25/docs/GI-GstBase-Structs-BitReader.html#v:bitReaderFree"
        })


#endif

-- method BitReader::get_bits_uint16
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "reader"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BitReader" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBitReader instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "val"
--           , argType = TBasicType TUInt16
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Pointer to a #guint16 to store the result"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "nbits"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of bits to read"
--                 , 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_reader_get_bits_uint16" gst_bit_reader_get_bits_uint16 :: 
    Ptr BitReader ->                        -- reader : TInterface (Name {namespace = "GstBase", name = "BitReader"})
    Ptr Word16 ->                           -- val : TBasicType TUInt16
    Word32 ->                               -- nbits : TBasicType TUInt
    IO CInt

-- | Read /@nbits@/ bits into /@val@/ and update the current position.
bitReaderGetBitsUint16 ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BitReader
    -- ^ /@reader@/: a t'GI.GstBase.Structs.BitReader.BitReader' instance
    -> Word32
    -- ^ /@nbits@/: number of bits to read
    -> m ((Bool, Word16))
    -- ^ __Returns:__ 'P.True' if successful, 'P.False' otherwise.
bitReaderGetBitsUint16 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BitReader -> Word32 -> m (Bool, Word16)
bitReaderGetBitsUint16 BitReader
reader Word32
nbits = IO (Bool, Word16) -> m (Bool, Word16)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Word16) -> m (Bool, Word16))
-> IO (Bool, Word16) -> m (Bool, Word16)
forall a b. (a -> b) -> a -> b
$ do
    Ptr BitReader
reader' <- BitReader -> IO (Ptr BitReader)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BitReader
reader
    Ptr Word16
val <- IO (Ptr Word16)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word16)
    CInt
result <- Ptr BitReader -> Ptr Word16 -> Word32 -> IO CInt
gst_bit_reader_get_bits_uint16 Ptr BitReader
reader' Ptr Word16
val Word32
nbits
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Word16
val' <- Ptr Word16 -> IO Word16
forall a. Storable a => Ptr a -> IO a
peek Ptr Word16
val
    BitReader -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BitReader
reader
    Ptr Word16 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word16
val
    (Bool, Word16) -> IO (Bool, Word16)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Word16
val')

#if defined(ENABLE_OVERLOADING)
data BitReaderGetBitsUint16MethodInfo
instance (signature ~ (Word32 -> m ((Bool, Word16))), MonadIO m) => O.OverloadedMethod BitReaderGetBitsUint16MethodInfo BitReader signature where
    overloadedMethod = bitReaderGetBitsUint16

instance O.OverloadedMethodInfo BitReaderGetBitsUint16MethodInfo BitReader where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstBase.Structs.BitReader.bitReaderGetBitsUint16",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstbase-1.0.25/docs/GI-GstBase-Structs-BitReader.html#v:bitReaderGetBitsUint16"
        })


#endif

-- method BitReader::get_bits_uint32
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "reader"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BitReader" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBitReader instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "val"
--           , argType = TBasicType TUInt32
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Pointer to a #guint32 to store the result"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "nbits"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of bits to read"
--                 , 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_reader_get_bits_uint32" gst_bit_reader_get_bits_uint32 :: 
    Ptr BitReader ->                        -- reader : TInterface (Name {namespace = "GstBase", name = "BitReader"})
    Ptr Word32 ->                           -- val : TBasicType TUInt32
    Word32 ->                               -- nbits : TBasicType TUInt
    IO CInt

-- | Read /@nbits@/ bits into /@val@/ and update the current position.
bitReaderGetBitsUint32 ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BitReader
    -- ^ /@reader@/: a t'GI.GstBase.Structs.BitReader.BitReader' instance
    -> Word32
    -- ^ /@nbits@/: number of bits to read
    -> m ((Bool, Word32))
    -- ^ __Returns:__ 'P.True' if successful, 'P.False' otherwise.
bitReaderGetBitsUint32 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BitReader -> Word32 -> m (Bool, Word32)
bitReaderGetBitsUint32 BitReader
reader Word32
nbits = IO (Bool, Word32) -> m (Bool, Word32)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Word32) -> m (Bool, Word32))
-> IO (Bool, Word32) -> m (Bool, Word32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr BitReader
reader' <- BitReader -> IO (Ptr BitReader)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BitReader
reader
    Ptr Word32
val <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    CInt
result <- Ptr BitReader -> Ptr Word32 -> Word32 -> IO CInt
gst_bit_reader_get_bits_uint32 Ptr BitReader
reader' Ptr Word32
val Word32
nbits
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Word32
val' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
val
    BitReader -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BitReader
reader
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
val
    (Bool, Word32) -> IO (Bool, Word32)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Word32
val')

#if defined(ENABLE_OVERLOADING)
data BitReaderGetBitsUint32MethodInfo
instance (signature ~ (Word32 -> m ((Bool, Word32))), MonadIO m) => O.OverloadedMethod BitReaderGetBitsUint32MethodInfo BitReader signature where
    overloadedMethod = bitReaderGetBitsUint32

instance O.OverloadedMethodInfo BitReaderGetBitsUint32MethodInfo BitReader where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstBase.Structs.BitReader.bitReaderGetBitsUint32",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstbase-1.0.25/docs/GI-GstBase-Structs-BitReader.html#v:bitReaderGetBitsUint32"
        })


#endif

-- method BitReader::get_bits_uint64
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "reader"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BitReader" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBitReader instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "val"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Pointer to a #guint64 to store the result"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "nbits"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of bits to read"
--                 , 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_reader_get_bits_uint64" gst_bit_reader_get_bits_uint64 :: 
    Ptr BitReader ->                        -- reader : TInterface (Name {namespace = "GstBase", name = "BitReader"})
    Ptr Word64 ->                           -- val : TBasicType TUInt64
    Word32 ->                               -- nbits : TBasicType TUInt
    IO CInt

-- | Read /@nbits@/ bits into /@val@/ and update the current position.
bitReaderGetBitsUint64 ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BitReader
    -- ^ /@reader@/: a t'GI.GstBase.Structs.BitReader.BitReader' instance
    -> Word32
    -- ^ /@nbits@/: number of bits to read
    -> m ((Bool, Word64))
    -- ^ __Returns:__ 'P.True' if successful, 'P.False' otherwise.
bitReaderGetBitsUint64 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BitReader -> Word32 -> m (Bool, Word64)
bitReaderGetBitsUint64 BitReader
reader Word32
nbits = IO (Bool, Word64) -> m (Bool, Word64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Word64) -> m (Bool, Word64))
-> IO (Bool, Word64) -> m (Bool, Word64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr BitReader
reader' <- BitReader -> IO (Ptr BitReader)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BitReader
reader
    Ptr Word64
val <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    CInt
result <- Ptr BitReader -> Ptr Word64 -> Word32 -> IO CInt
gst_bit_reader_get_bits_uint64 Ptr BitReader
reader' Ptr Word64
val Word32
nbits
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Word64
val' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
val
    BitReader -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BitReader
reader
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
val
    (Bool, Word64) -> IO (Bool, Word64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Word64
val')

#if defined(ENABLE_OVERLOADING)
data BitReaderGetBitsUint64MethodInfo
instance (signature ~ (Word32 -> m ((Bool, Word64))), MonadIO m) => O.OverloadedMethod BitReaderGetBitsUint64MethodInfo BitReader signature where
    overloadedMethod = bitReaderGetBitsUint64

instance O.OverloadedMethodInfo BitReaderGetBitsUint64MethodInfo BitReader where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstBase.Structs.BitReader.bitReaderGetBitsUint64",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstbase-1.0.25/docs/GI-GstBase-Structs-BitReader.html#v:bitReaderGetBitsUint64"
        })


#endif

-- method BitReader::get_bits_uint8
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "reader"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BitReader" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBitReader instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "val"
--           , argType = TBasicType TUInt8
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Pointer to a #guint8 to store the result"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "nbits"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of bits to read"
--                 , 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_reader_get_bits_uint8" gst_bit_reader_get_bits_uint8 :: 
    Ptr BitReader ->                        -- reader : TInterface (Name {namespace = "GstBase", name = "BitReader"})
    Ptr Word8 ->                            -- val : TBasicType TUInt8
    Word32 ->                               -- nbits : TBasicType TUInt
    IO CInt

-- | Read /@nbits@/ bits into /@val@/ and update the current position.
bitReaderGetBitsUint8 ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BitReader
    -- ^ /@reader@/: a t'GI.GstBase.Structs.BitReader.BitReader' instance
    -> Word32
    -- ^ /@nbits@/: number of bits to read
    -> m ((Bool, Word8))
    -- ^ __Returns:__ 'P.True' if successful, 'P.False' otherwise.
bitReaderGetBitsUint8 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BitReader -> Word32 -> m (Bool, Word8)
bitReaderGetBitsUint8 BitReader
reader Word32
nbits = IO (Bool, Word8) -> m (Bool, Word8)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Word8) -> m (Bool, Word8))
-> IO (Bool, Word8) -> m (Bool, Word8)
forall a b. (a -> b) -> a -> b
$ do
    Ptr BitReader
reader' <- BitReader -> IO (Ptr BitReader)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BitReader
reader
    Ptr Word8
val <- IO (Ptr Word8)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word8)
    CInt
result <- Ptr BitReader -> Ptr Word8 -> Word32 -> IO CInt
gst_bit_reader_get_bits_uint8 Ptr BitReader
reader' Ptr Word8
val Word32
nbits
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Word8
val' <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
val
    BitReader -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BitReader
reader
    Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
val
    (Bool, Word8) -> IO (Bool, Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Word8
val')

#if defined(ENABLE_OVERLOADING)
data BitReaderGetBitsUint8MethodInfo
instance (signature ~ (Word32 -> m ((Bool, Word8))), MonadIO m) => O.OverloadedMethod BitReaderGetBitsUint8MethodInfo BitReader signature where
    overloadedMethod = bitReaderGetBitsUint8

instance O.OverloadedMethodInfo BitReaderGetBitsUint8MethodInfo BitReader where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstBase.Structs.BitReader.bitReaderGetBitsUint8",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstbase-1.0.25/docs/GI-GstBase-Structs-BitReader.html#v:bitReaderGetBitsUint8"
        })


#endif

-- method BitReader::get_pos
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "reader"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BitReader" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBitReader 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_reader_get_pos" gst_bit_reader_get_pos :: 
    Ptr BitReader ->                        -- reader : TInterface (Name {namespace = "GstBase", name = "BitReader"})
    IO Word32

-- | Returns the current position of a t'GI.GstBase.Structs.BitReader.BitReader' instance in bits.
bitReaderGetPos ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BitReader
    -- ^ /@reader@/: a t'GI.GstBase.Structs.BitReader.BitReader' instance
    -> m Word32
    -- ^ __Returns:__ The current position of /@reader@/ in bits.
bitReaderGetPos :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BitReader -> m Word32
bitReaderGetPos BitReader
reader = 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 BitReader
reader' <- BitReader -> IO (Ptr BitReader)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BitReader
reader
    Word32
result <- Ptr BitReader -> IO Word32
gst_bit_reader_get_pos Ptr BitReader
reader'
    BitReader -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BitReader
reader
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data BitReaderGetPosMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.OverloadedMethod BitReaderGetPosMethodInfo BitReader signature where
    overloadedMethod = bitReaderGetPos

instance O.OverloadedMethodInfo BitReaderGetPosMethodInfo BitReader where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstBase.Structs.BitReader.bitReaderGetPos",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstbase-1.0.25/docs/GI-GstBase-Structs-BitReader.html#v:bitReaderGetPos"
        })


#endif

-- method BitReader::get_remaining
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "reader"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BitReader" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBitReader 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_reader_get_remaining" gst_bit_reader_get_remaining :: 
    Ptr BitReader ->                        -- reader : TInterface (Name {namespace = "GstBase", name = "BitReader"})
    IO Word32

-- | Returns the remaining number of bits of a t'GI.GstBase.Structs.BitReader.BitReader' instance.
bitReaderGetRemaining ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BitReader
    -- ^ /@reader@/: a t'GI.GstBase.Structs.BitReader.BitReader' instance
    -> m Word32
    -- ^ __Returns:__ The remaining number of bits of /@reader@/ instance.
bitReaderGetRemaining :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BitReader -> m Word32
bitReaderGetRemaining BitReader
reader = 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 BitReader
reader' <- BitReader -> IO (Ptr BitReader)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BitReader
reader
    Word32
result <- Ptr BitReader -> IO Word32
gst_bit_reader_get_remaining Ptr BitReader
reader'
    BitReader -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BitReader
reader
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data BitReaderGetRemainingMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.OverloadedMethod BitReaderGetRemainingMethodInfo BitReader signature where
    overloadedMethod = bitReaderGetRemaining

instance O.OverloadedMethodInfo BitReaderGetRemainingMethodInfo BitReader where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstBase.Structs.BitReader.bitReaderGetRemaining",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstbase-1.0.25/docs/GI-GstBase-Structs-BitReader.html#v:bitReaderGetRemaining"
        })


#endif

-- method BitReader::get_size
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "reader"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BitReader" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBitReader 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_reader_get_size" gst_bit_reader_get_size :: 
    Ptr BitReader ->                        -- reader : TInterface (Name {namespace = "GstBase", name = "BitReader"})
    IO Word32

-- | Returns the total number of bits of a t'GI.GstBase.Structs.BitReader.BitReader' instance.
bitReaderGetSize ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BitReader
    -- ^ /@reader@/: a t'GI.GstBase.Structs.BitReader.BitReader' instance
    -> m Word32
    -- ^ __Returns:__ The total number of bits of /@reader@/ instance.
bitReaderGetSize :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BitReader -> m Word32
bitReaderGetSize BitReader
reader = 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 BitReader
reader' <- BitReader -> IO (Ptr BitReader)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BitReader
reader
    Word32
result <- Ptr BitReader -> IO Word32
gst_bit_reader_get_size Ptr BitReader
reader'
    BitReader -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BitReader
reader
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data BitReaderGetSizeMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.OverloadedMethod BitReaderGetSizeMethodInfo BitReader signature where
    overloadedMethod = bitReaderGetSize

instance O.OverloadedMethodInfo BitReaderGetSizeMethodInfo BitReader where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstBase.Structs.BitReader.bitReaderGetSize",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstbase-1.0.25/docs/GI-GstBase-Structs-BitReader.html#v:bitReaderGetSize"
        })


#endif

-- method BitReader::init
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "reader"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BitReader" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBitReader instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TCArray False (-1) 2 (TBasicType TUInt8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data from which the bit reader should read"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "size"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Size of @data in bytes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "size"
--              , argType = TBasicType TUInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "Size of @data in bytes"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_bit_reader_init" gst_bit_reader_init :: 
    Ptr BitReader ->                        -- reader : TInterface (Name {namespace = "GstBase", name = "BitReader"})
    Ptr Word8 ->                            -- data : TCArray False (-1) 2 (TBasicType TUInt8)
    Word32 ->                               -- size : TBasicType TUInt
    IO ()

-- | Initializes a t'GI.GstBase.Structs.BitReader.BitReader' instance to read from /@data@/. This function
-- can be called on already initialized instances.
bitReaderInit ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BitReader
    -- ^ /@reader@/: a t'GI.GstBase.Structs.BitReader.BitReader' instance
    -> ByteString
    -- ^ /@data@/: data from which the bit reader should read
    -> m ()
bitReaderInit :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BitReader -> ByteString -> m ()
bitReaderInit BitReader
reader ByteString
data_ = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    let size :: Word32
size = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
data_
    Ptr BitReader
reader' <- BitReader -> IO (Ptr BitReader)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BitReader
reader
    Ptr Word8
data_' <- ByteString -> IO (Ptr Word8)
packByteString ByteString
data_
    Ptr BitReader -> Ptr Word8 -> Word32 -> IO ()
gst_bit_reader_init Ptr BitReader
reader' Ptr Word8
data_' Word32
size
    BitReader -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BitReader
reader
    Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
data_'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BitReaderInitMethodInfo
instance (signature ~ (ByteString -> m ()), MonadIO m) => O.OverloadedMethod BitReaderInitMethodInfo BitReader signature where
    overloadedMethod = bitReaderInit

instance O.OverloadedMethodInfo BitReaderInitMethodInfo BitReader where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstBase.Structs.BitReader.bitReaderInit",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstbase-1.0.25/docs/GI-GstBase-Structs-BitReader.html#v:bitReaderInit"
        })


#endif

-- method BitReader::peek_bits_uint16
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "reader"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BitReader" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBitReader instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "val"
--           , argType = TBasicType TUInt16
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Pointer to a #guint16 to store the result"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "nbits"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of bits to read"
--                 , 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_reader_peek_bits_uint16" gst_bit_reader_peek_bits_uint16 :: 
    Ptr BitReader ->                        -- reader : TInterface (Name {namespace = "GstBase", name = "BitReader"})
    Ptr Word16 ->                           -- val : TBasicType TUInt16
    Word32 ->                               -- nbits : TBasicType TUInt
    IO CInt

-- | Read /@nbits@/ bits into /@val@/ but keep the current position.
bitReaderPeekBitsUint16 ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BitReader
    -- ^ /@reader@/: a t'GI.GstBase.Structs.BitReader.BitReader' instance
    -> Word32
    -- ^ /@nbits@/: number of bits to read
    -> m ((Bool, Word16))
    -- ^ __Returns:__ 'P.True' if successful, 'P.False' otherwise.
bitReaderPeekBitsUint16 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BitReader -> Word32 -> m (Bool, Word16)
bitReaderPeekBitsUint16 BitReader
reader Word32
nbits = IO (Bool, Word16) -> m (Bool, Word16)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Word16) -> m (Bool, Word16))
-> IO (Bool, Word16) -> m (Bool, Word16)
forall a b. (a -> b) -> a -> b
$ do
    Ptr BitReader
reader' <- BitReader -> IO (Ptr BitReader)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BitReader
reader
    Ptr Word16
val <- IO (Ptr Word16)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word16)
    CInt
result <- Ptr BitReader -> Ptr Word16 -> Word32 -> IO CInt
gst_bit_reader_peek_bits_uint16 Ptr BitReader
reader' Ptr Word16
val Word32
nbits
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Word16
val' <- Ptr Word16 -> IO Word16
forall a. Storable a => Ptr a -> IO a
peek Ptr Word16
val
    BitReader -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BitReader
reader
    Ptr Word16 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word16
val
    (Bool, Word16) -> IO (Bool, Word16)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Word16
val')

#if defined(ENABLE_OVERLOADING)
data BitReaderPeekBitsUint16MethodInfo
instance (signature ~ (Word32 -> m ((Bool, Word16))), MonadIO m) => O.OverloadedMethod BitReaderPeekBitsUint16MethodInfo BitReader signature where
    overloadedMethod = bitReaderPeekBitsUint16

instance O.OverloadedMethodInfo BitReaderPeekBitsUint16MethodInfo BitReader where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstBase.Structs.BitReader.bitReaderPeekBitsUint16",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstbase-1.0.25/docs/GI-GstBase-Structs-BitReader.html#v:bitReaderPeekBitsUint16"
        })


#endif

-- method BitReader::peek_bits_uint32
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "reader"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BitReader" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBitReader instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "val"
--           , argType = TBasicType TUInt32
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Pointer to a #guint32 to store the result"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "nbits"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of bits to read"
--                 , 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_reader_peek_bits_uint32" gst_bit_reader_peek_bits_uint32 :: 
    Ptr BitReader ->                        -- reader : TInterface (Name {namespace = "GstBase", name = "BitReader"})
    Ptr Word32 ->                           -- val : TBasicType TUInt32
    Word32 ->                               -- nbits : TBasicType TUInt
    IO CInt

-- | Read /@nbits@/ bits into /@val@/ but keep the current position.
bitReaderPeekBitsUint32 ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BitReader
    -- ^ /@reader@/: a t'GI.GstBase.Structs.BitReader.BitReader' instance
    -> Word32
    -- ^ /@nbits@/: number of bits to read
    -> m ((Bool, Word32))
    -- ^ __Returns:__ 'P.True' if successful, 'P.False' otherwise.
bitReaderPeekBitsUint32 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BitReader -> Word32 -> m (Bool, Word32)
bitReaderPeekBitsUint32 BitReader
reader Word32
nbits = IO (Bool, Word32) -> m (Bool, Word32)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Word32) -> m (Bool, Word32))
-> IO (Bool, Word32) -> m (Bool, Word32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr BitReader
reader' <- BitReader -> IO (Ptr BitReader)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BitReader
reader
    Ptr Word32
val <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    CInt
result <- Ptr BitReader -> Ptr Word32 -> Word32 -> IO CInt
gst_bit_reader_peek_bits_uint32 Ptr BitReader
reader' Ptr Word32
val Word32
nbits
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Word32
val' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
val
    BitReader -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BitReader
reader
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
val
    (Bool, Word32) -> IO (Bool, Word32)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Word32
val')

#if defined(ENABLE_OVERLOADING)
data BitReaderPeekBitsUint32MethodInfo
instance (signature ~ (Word32 -> m ((Bool, Word32))), MonadIO m) => O.OverloadedMethod BitReaderPeekBitsUint32MethodInfo BitReader signature where
    overloadedMethod = bitReaderPeekBitsUint32

instance O.OverloadedMethodInfo BitReaderPeekBitsUint32MethodInfo BitReader where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstBase.Structs.BitReader.bitReaderPeekBitsUint32",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstbase-1.0.25/docs/GI-GstBase-Structs-BitReader.html#v:bitReaderPeekBitsUint32"
        })


#endif

-- method BitReader::peek_bits_uint64
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "reader"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BitReader" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBitReader instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "val"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Pointer to a #guint64 to store the result"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "nbits"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of bits to read"
--                 , 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_reader_peek_bits_uint64" gst_bit_reader_peek_bits_uint64 :: 
    Ptr BitReader ->                        -- reader : TInterface (Name {namespace = "GstBase", name = "BitReader"})
    Ptr Word64 ->                           -- val : TBasicType TUInt64
    Word32 ->                               -- nbits : TBasicType TUInt
    IO CInt

-- | Read /@nbits@/ bits into /@val@/ but keep the current position.
bitReaderPeekBitsUint64 ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BitReader
    -- ^ /@reader@/: a t'GI.GstBase.Structs.BitReader.BitReader' instance
    -> Word32
    -- ^ /@nbits@/: number of bits to read
    -> m ((Bool, Word64))
    -- ^ __Returns:__ 'P.True' if successful, 'P.False' otherwise.
bitReaderPeekBitsUint64 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BitReader -> Word32 -> m (Bool, Word64)
bitReaderPeekBitsUint64 BitReader
reader Word32
nbits = IO (Bool, Word64) -> m (Bool, Word64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Word64) -> m (Bool, Word64))
-> IO (Bool, Word64) -> m (Bool, Word64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr BitReader
reader' <- BitReader -> IO (Ptr BitReader)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BitReader
reader
    Ptr Word64
val <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    CInt
result <- Ptr BitReader -> Ptr Word64 -> Word32 -> IO CInt
gst_bit_reader_peek_bits_uint64 Ptr BitReader
reader' Ptr Word64
val Word32
nbits
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Word64
val' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
val
    BitReader -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BitReader
reader
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
val
    (Bool, Word64) -> IO (Bool, Word64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Word64
val')

#if defined(ENABLE_OVERLOADING)
data BitReaderPeekBitsUint64MethodInfo
instance (signature ~ (Word32 -> m ((Bool, Word64))), MonadIO m) => O.OverloadedMethod BitReaderPeekBitsUint64MethodInfo BitReader signature where
    overloadedMethod = bitReaderPeekBitsUint64

instance O.OverloadedMethodInfo BitReaderPeekBitsUint64MethodInfo BitReader where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstBase.Structs.BitReader.bitReaderPeekBitsUint64",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstbase-1.0.25/docs/GI-GstBase-Structs-BitReader.html#v:bitReaderPeekBitsUint64"
        })


#endif

-- method BitReader::peek_bits_uint8
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "reader"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BitReader" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBitReader instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "val"
--           , argType = TBasicType TUInt8
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Pointer to a #guint8 to store the result"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "nbits"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of bits to read"
--                 , 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_reader_peek_bits_uint8" gst_bit_reader_peek_bits_uint8 :: 
    Ptr BitReader ->                        -- reader : TInterface (Name {namespace = "GstBase", name = "BitReader"})
    Ptr Word8 ->                            -- val : TBasicType TUInt8
    Word32 ->                               -- nbits : TBasicType TUInt
    IO CInt

-- | Read /@nbits@/ bits into /@val@/ but keep the current position.
bitReaderPeekBitsUint8 ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BitReader
    -- ^ /@reader@/: a t'GI.GstBase.Structs.BitReader.BitReader' instance
    -> Word32
    -- ^ /@nbits@/: number of bits to read
    -> m ((Bool, Word8))
    -- ^ __Returns:__ 'P.True' if successful, 'P.False' otherwise.
bitReaderPeekBitsUint8 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BitReader -> Word32 -> m (Bool, Word8)
bitReaderPeekBitsUint8 BitReader
reader Word32
nbits = IO (Bool, Word8) -> m (Bool, Word8)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Word8) -> m (Bool, Word8))
-> IO (Bool, Word8) -> m (Bool, Word8)
forall a b. (a -> b) -> a -> b
$ do
    Ptr BitReader
reader' <- BitReader -> IO (Ptr BitReader)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BitReader
reader
    Ptr Word8
val <- IO (Ptr Word8)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word8)
    CInt
result <- Ptr BitReader -> Ptr Word8 -> Word32 -> IO CInt
gst_bit_reader_peek_bits_uint8 Ptr BitReader
reader' Ptr Word8
val Word32
nbits
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Word8
val' <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
val
    BitReader -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BitReader
reader
    Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
val
    (Bool, Word8) -> IO (Bool, Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Word8
val')

#if defined(ENABLE_OVERLOADING)
data BitReaderPeekBitsUint8MethodInfo
instance (signature ~ (Word32 -> m ((Bool, Word8))), MonadIO m) => O.OverloadedMethod BitReaderPeekBitsUint8MethodInfo BitReader signature where
    overloadedMethod = bitReaderPeekBitsUint8

instance O.OverloadedMethodInfo BitReaderPeekBitsUint8MethodInfo BitReader where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstBase.Structs.BitReader.bitReaderPeekBitsUint8",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstbase-1.0.25/docs/GI-GstBase-Structs-BitReader.html#v:bitReaderPeekBitsUint8"
        })


#endif

-- method BitReader::set_pos
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "reader"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BitReader" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBitReader instance"
--                 , 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 = Just "The new position in bits"
--                 , 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_reader_set_pos" gst_bit_reader_set_pos :: 
    Ptr BitReader ->                        -- reader : TInterface (Name {namespace = "GstBase", name = "BitReader"})
    Word32 ->                               -- pos : TBasicType TUInt
    IO CInt

-- | Sets the new position of a t'GI.GstBase.Structs.BitReader.BitReader' instance to /@pos@/ in bits.
bitReaderSetPos ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BitReader
    -- ^ /@reader@/: a t'GI.GstBase.Structs.BitReader.BitReader' instance
    -> Word32
    -- ^ /@pos@/: The new position in bits
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the position could be set successfully, 'P.False'
    -- otherwise.
bitReaderSetPos :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BitReader -> Word32 -> m Bool
bitReaderSetPos BitReader
reader 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 BitReader
reader' <- BitReader -> IO (Ptr BitReader)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BitReader
reader
    CInt
result <- Ptr BitReader -> Word32 -> IO CInt
gst_bit_reader_set_pos Ptr BitReader
reader' Word32
pos
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    BitReader -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BitReader
reader
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BitReaderSetPosMethodInfo
instance (signature ~ (Word32 -> m Bool), MonadIO m) => O.OverloadedMethod BitReaderSetPosMethodInfo BitReader signature where
    overloadedMethod = bitReaderSetPos

instance O.OverloadedMethodInfo BitReaderSetPosMethodInfo BitReader where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstBase.Structs.BitReader.bitReaderSetPos",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstbase-1.0.25/docs/GI-GstBase-Structs-BitReader.html#v:bitReaderSetPos"
        })


#endif

-- method BitReader::skip
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "reader"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BitReader" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBitReader instance"
--                 , 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 "the number of bits to skip"
--                 , 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_reader_skip" gst_bit_reader_skip :: 
    Ptr BitReader ->                        -- reader : TInterface (Name {namespace = "GstBase", name = "BitReader"})
    Word32 ->                               -- nbits : TBasicType TUInt
    IO CInt

-- | Skips /@nbits@/ bits of the t'GI.GstBase.Structs.BitReader.BitReader' instance.
bitReaderSkip ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BitReader
    -- ^ /@reader@/: a t'GI.GstBase.Structs.BitReader.BitReader' instance
    -> Word32
    -- ^ /@nbits@/: the number of bits to skip
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@nbits@/ bits could be skipped, 'P.False' otherwise.
bitReaderSkip :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BitReader -> Word32 -> m Bool
bitReaderSkip BitReader
reader 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 BitReader
reader' <- BitReader -> IO (Ptr BitReader)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BitReader
reader
    CInt
result <- Ptr BitReader -> Word32 -> IO CInt
gst_bit_reader_skip Ptr BitReader
reader' Word32
nbits
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    BitReader -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BitReader
reader
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BitReaderSkipMethodInfo
instance (signature ~ (Word32 -> m Bool), MonadIO m) => O.OverloadedMethod BitReaderSkipMethodInfo BitReader signature where
    overloadedMethod = bitReaderSkip

instance O.OverloadedMethodInfo BitReaderSkipMethodInfo BitReader where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstBase.Structs.BitReader.bitReaderSkip",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstbase-1.0.25/docs/GI-GstBase-Structs-BitReader.html#v:bitReaderSkip"
        })


#endif

-- method BitReader::skip_to_byte
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "reader"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BitReader" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBitReader instance"
--                 , 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_reader_skip_to_byte" gst_bit_reader_skip_to_byte :: 
    Ptr BitReader ->                        -- reader : TInterface (Name {namespace = "GstBase", name = "BitReader"})
    IO CInt

-- | Skips until the next byte.
bitReaderSkipToByte ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BitReader
    -- ^ /@reader@/: a t'GI.GstBase.Structs.BitReader.BitReader' instance
    -> m Bool
    -- ^ __Returns:__ 'P.True' if successful, 'P.False' otherwise.
bitReaderSkipToByte :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BitReader -> m Bool
bitReaderSkipToByte BitReader
reader = 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 BitReader
reader' <- BitReader -> IO (Ptr BitReader)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BitReader
reader
    CInt
result <- Ptr BitReader -> IO CInt
gst_bit_reader_skip_to_byte Ptr BitReader
reader'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    BitReader -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BitReader
reader
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BitReaderSkipToByteMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod BitReaderSkipToByteMethodInfo BitReader signature where
    overloadedMethod = bitReaderSkipToByte

instance O.OverloadedMethodInfo BitReaderSkipToByteMethodInfo BitReader where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstBase.Structs.BitReader.bitReaderSkipToByte",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstbase-1.0.25/docs/GI-GstBase-Structs-BitReader.html#v:bitReaderSkipToByte"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveBitReaderMethod (t :: Symbol) (o :: *) :: * where
    ResolveBitReaderMethod "free" o = BitReaderFreeMethodInfo
    ResolveBitReaderMethod "init" o = BitReaderInitMethodInfo
    ResolveBitReaderMethod "peekBitsUint16" o = BitReaderPeekBitsUint16MethodInfo
    ResolveBitReaderMethod "peekBitsUint32" o = BitReaderPeekBitsUint32MethodInfo
    ResolveBitReaderMethod "peekBitsUint64" o = BitReaderPeekBitsUint64MethodInfo
    ResolveBitReaderMethod "peekBitsUint8" o = BitReaderPeekBitsUint8MethodInfo
    ResolveBitReaderMethod "skip" o = BitReaderSkipMethodInfo
    ResolveBitReaderMethod "skipToByte" o = BitReaderSkipToByteMethodInfo
    ResolveBitReaderMethod "getBitsUint16" o = BitReaderGetBitsUint16MethodInfo
    ResolveBitReaderMethod "getBitsUint32" o = BitReaderGetBitsUint32MethodInfo
    ResolveBitReaderMethod "getBitsUint64" o = BitReaderGetBitsUint64MethodInfo
    ResolveBitReaderMethod "getBitsUint8" o = BitReaderGetBitsUint8MethodInfo
    ResolveBitReaderMethod "getPos" o = BitReaderGetPosMethodInfo
    ResolveBitReaderMethod "getRemaining" o = BitReaderGetRemainingMethodInfo
    ResolveBitReaderMethod "getSize" o = BitReaderGetSizeMethodInfo
    ResolveBitReaderMethod "setPos" o = BitReaderSetPosMethodInfo
    ResolveBitReaderMethod l o = O.MethodResolutionFailed l o

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

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveBitReaderMethod t BitReader, O.OverloadedMethod info BitReader p, R.HasField t BitReader p) => R.HasField t BitReader p where
    getField = O.overloadedMethod @info

#endif

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

#endif