{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Information for a video format.

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

module GI.GstVideo.Structs.VideoFormatInfo
    ( 

-- * Exported types
    VideoFormatInfo(..)                     ,
    newZeroVideoFormatInfo                  ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [component]("GI.GstVideo.Structs.VideoFormatInfo#g:method:component").
-- 
-- ==== Getters
-- /None/.
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveVideoFormatInfoMethod            ,
#endif

-- ** component #method:component#

#if defined(ENABLE_OVERLOADING)
    VideoFormatInfoComponentMethodInfo      ,
#endif
    videoFormatInfoComponent                ,




 -- * Properties


-- ** bits #attr:bits#
-- | The number of bits used to pack data items. This can be less than 8
--    when multiple pixels are stored in a byte. for values > 8 multiple bytes
--    should be read according to the endianness flag before applying the shift
--    and mask.

    getVideoFormatInfoBits                  ,
    setVideoFormatInfoBits                  ,
#if defined(ENABLE_OVERLOADING)
    videoFormatInfo_bits                    ,
#endif


-- ** description #attr:description#
-- | use readable description of the format

    clearVideoFormatInfoDescription         ,
    getVideoFormatInfoDescription           ,
    setVideoFormatInfoDescription           ,
#if defined(ENABLE_OVERLOADING)
    videoFormatInfo_description             ,
#endif


-- ** flags #attr:flags#
-- | t'GI.GstVideo.Flags.VideoFormatFlags'

    getVideoFormatInfoFlags                 ,
    setVideoFormatInfoFlags                 ,
#if defined(ENABLE_OVERLOADING)
    videoFormatInfo_flags                   ,
#endif


-- ** format #attr:format#
-- | t'GI.GstVideo.Enums.VideoFormat'

    getVideoFormatInfoFormat                ,
    setVideoFormatInfoFormat                ,
#if defined(ENABLE_OVERLOADING)
    videoFormatInfo_format                  ,
#endif


-- ** nComponents #attr:nComponents#
-- | the number of components in the video format.

    getVideoFormatInfoNComponents           ,
    setVideoFormatInfoNComponents           ,
#if defined(ENABLE_OVERLOADING)
    videoFormatInfo_nComponents             ,
#endif


-- ** nPlanes #attr:nPlanes#
-- | the number of planes for this format. The number of planes can be
--    less than the amount of components when multiple components are packed into
--    one plane.

    getVideoFormatInfoNPlanes               ,
    setVideoFormatInfoNPlanes               ,
#if defined(ENABLE_OVERLOADING)
    videoFormatInfo_nPlanes                 ,
#endif


-- ** name #attr:name#
-- | string representation of the format

    clearVideoFormatInfoName                ,
    getVideoFormatInfoName                  ,
    setVideoFormatInfoName                  ,
#if defined(ENABLE_OVERLOADING)
    videoFormatInfo_name                    ,
#endif


-- ** packFunc #attr:packFunc#
-- | an pack function for this format

    clearVideoFormatInfoPackFunc            ,
    getVideoFormatInfoPackFunc              ,
    setVideoFormatInfoPackFunc              ,
#if defined(ENABLE_OVERLOADING)
    videoFormatInfo_packFunc                ,
#endif


-- ** packLines #attr:packLines#
-- | the amount of lines that will be packed

    getVideoFormatInfoPackLines             ,
    setVideoFormatInfoPackLines             ,
#if defined(ENABLE_OVERLOADING)
    videoFormatInfo_packLines               ,
#endif


-- ** tileHs #attr:tileHs#
-- | The height of a tile, in bytes, represented as a shift

    getVideoFormatInfoTileHs                ,
    setVideoFormatInfoTileHs                ,
#if defined(ENABLE_OVERLOADING)
    videoFormatInfo_tileHs                  ,
#endif


-- ** tileMode #attr:tileMode#
-- | The tiling mode

    getVideoFormatInfoTileMode              ,
    setVideoFormatInfoTileMode              ,
#if defined(ENABLE_OVERLOADING)
    videoFormatInfo_tileMode                ,
#endif


-- ** tileWs #attr:tileWs#
-- | The width of a tile, in bytes, represented as a shift

    getVideoFormatInfoTileWs                ,
    setVideoFormatInfoTileWs                ,
#if defined(ENABLE_OVERLOADING)
    videoFormatInfo_tileWs                  ,
#endif


-- ** unpackFormat #attr:unpackFormat#
-- | the format of the unpacked pixels. This format must have the
--     @/GST_VIDEO_FORMAT_FLAG_UNPACK/@ flag set.

    getVideoFormatInfoUnpackFormat          ,
    setVideoFormatInfoUnpackFormat          ,
#if defined(ENABLE_OVERLOADING)
    videoFormatInfo_unpackFormat            ,
#endif


-- ** unpackFunc #attr:unpackFunc#
-- | an unpack function for this format

    clearVideoFormatInfoUnpackFunc          ,
    getVideoFormatInfoUnpackFunc            ,
    setVideoFormatInfoUnpackFunc            ,
#if defined(ENABLE_OVERLOADING)
    videoFormatInfo_unpackFunc              ,
#endif




    ) 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

import qualified GI.GstVideo.Callbacks as GstVideo.Callbacks
import {-# SOURCE #-} qualified GI.GstVideo.Enums as GstVideo.Enums
import {-# SOURCE #-} qualified GI.GstVideo.Flags as GstVideo.Flags

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

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

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


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

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


-- | Get the value of the “@format@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' videoFormatInfo #format
-- @
getVideoFormatInfoFormat :: MonadIO m => VideoFormatInfo -> m GstVideo.Enums.VideoFormat
getVideoFormatInfoFormat :: forall (m :: * -> *). MonadIO m => VideoFormatInfo -> m VideoFormat
getVideoFormatInfoFormat VideoFormatInfo
s = IO VideoFormat -> m VideoFormat
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO VideoFormat -> m VideoFormat)
-> IO VideoFormat -> m VideoFormat
forall a b. (a -> b) -> a -> b
$ VideoFormatInfo
-> (Ptr VideoFormatInfo -> IO VideoFormat) -> IO VideoFormat
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoFormatInfo
s ((Ptr VideoFormatInfo -> IO VideoFormat) -> IO VideoFormat)
-> (Ptr VideoFormatInfo -> IO VideoFormat) -> IO VideoFormat
forall a b. (a -> b) -> a -> b
$ \Ptr VideoFormatInfo
ptr -> do
    CUInt
val <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr VideoFormatInfo
ptr Ptr VideoFormatInfo -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) :: IO CUInt
    let val' :: VideoFormat
val' = (Int -> VideoFormat
forall a. Enum a => Int -> a
toEnum (Int -> VideoFormat) -> (CUInt -> Int) -> CUInt -> VideoFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
val
    VideoFormat -> IO VideoFormat
forall (m :: * -> *) a. Monad m => a -> m a
return VideoFormat
val'

-- | Set the value of the “@format@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' videoFormatInfo [ #format 'Data.GI.Base.Attributes.:=' value ]
-- @
setVideoFormatInfoFormat :: MonadIO m => VideoFormatInfo -> GstVideo.Enums.VideoFormat -> m ()
setVideoFormatInfoFormat :: forall (m :: * -> *).
MonadIO m =>
VideoFormatInfo -> VideoFormat -> m ()
setVideoFormatInfoFormat VideoFormatInfo
s VideoFormat
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ VideoFormatInfo -> (Ptr VideoFormatInfo -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoFormatInfo
s ((Ptr VideoFormatInfo -> IO ()) -> IO ())
-> (Ptr VideoFormatInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr VideoFormatInfo
ptr -> do
    let val' :: CUInt
val' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (VideoFormat -> Int) -> VideoFormat -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VideoFormat -> Int
forall a. Enum a => a -> Int
fromEnum) VideoFormat
val
    Ptr CUInt -> CUInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr VideoFormatInfo
ptr Ptr VideoFormatInfo -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (CUInt
val' :: CUInt)

#if defined(ENABLE_OVERLOADING)
data VideoFormatInfoFormatFieldInfo
instance AttrInfo VideoFormatInfoFormatFieldInfo where
    type AttrBaseTypeConstraint VideoFormatInfoFormatFieldInfo = (~) VideoFormatInfo
    type AttrAllowedOps VideoFormatInfoFormatFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoFormatInfoFormatFieldInfo = (~) GstVideo.Enums.VideoFormat
    type AttrTransferTypeConstraint VideoFormatInfoFormatFieldInfo = (~)GstVideo.Enums.VideoFormat
    type AttrTransferType VideoFormatInfoFormatFieldInfo = GstVideo.Enums.VideoFormat
    type AttrGetType VideoFormatInfoFormatFieldInfo = GstVideo.Enums.VideoFormat
    type AttrLabel VideoFormatInfoFormatFieldInfo = "format"
    type AttrOrigin VideoFormatInfoFormatFieldInfo = VideoFormatInfo
    attrGet = getVideoFormatInfoFormat
    attrSet = setVideoFormatInfoFormat
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Structs.VideoFormatInfo.format"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.25/docs/GI-GstVideo-Structs-VideoFormatInfo.html#g:attr:format"
        })

videoFormatInfo_format :: AttrLabelProxy "format"
videoFormatInfo_format = AttrLabelProxy

#endif


-- | Get the value of the “@name@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' videoFormatInfo #name
-- @
getVideoFormatInfoName :: MonadIO m => VideoFormatInfo -> m (Maybe T.Text)
getVideoFormatInfoName :: forall (m :: * -> *).
MonadIO m =>
VideoFormatInfo -> m (Maybe Text)
getVideoFormatInfoName VideoFormatInfo
s = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ VideoFormatInfo
-> (Ptr VideoFormatInfo -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoFormatInfo
s ((Ptr VideoFormatInfo -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr VideoFormatInfo -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr VideoFormatInfo
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr VideoFormatInfo
ptr Ptr VideoFormatInfo -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) :: IO CString
    Maybe Text
result <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull CString
val ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
val' -> do
        Text
val'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
val'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
val''
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
result

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

-- | Set the value of the “@name@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #name
-- @
clearVideoFormatInfoName :: MonadIO m => VideoFormatInfo -> m ()
clearVideoFormatInfoName :: forall (m :: * -> *). MonadIO m => VideoFormatInfo -> m ()
clearVideoFormatInfoName VideoFormatInfo
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ VideoFormatInfo -> (Ptr VideoFormatInfo -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoFormatInfo
s ((Ptr VideoFormatInfo -> IO ()) -> IO ())
-> (Ptr VideoFormatInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr VideoFormatInfo
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr VideoFormatInfo
ptr Ptr VideoFormatInfo -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (CString
forall a. Ptr a
FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING)
data VideoFormatInfoNameFieldInfo
instance AttrInfo VideoFormatInfoNameFieldInfo where
    type AttrBaseTypeConstraint VideoFormatInfoNameFieldInfo = (~) VideoFormatInfo
    type AttrAllowedOps VideoFormatInfoNameFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint VideoFormatInfoNameFieldInfo = (~) CString
    type AttrTransferTypeConstraint VideoFormatInfoNameFieldInfo = (~)CString
    type AttrTransferType VideoFormatInfoNameFieldInfo = CString
    type AttrGetType VideoFormatInfoNameFieldInfo = Maybe T.Text
    type AttrLabel VideoFormatInfoNameFieldInfo = "name"
    type AttrOrigin VideoFormatInfoNameFieldInfo = VideoFormatInfo
    attrGet = getVideoFormatInfoName
    attrSet = setVideoFormatInfoName
    attrConstruct = undefined
    attrClear = clearVideoFormatInfoName
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Structs.VideoFormatInfo.name"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.25/docs/GI-GstVideo-Structs-VideoFormatInfo.html#g:attr:name"
        })

videoFormatInfo_name :: AttrLabelProxy "name"
videoFormatInfo_name = AttrLabelProxy

#endif


-- | Get the value of the “@description@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' videoFormatInfo #description
-- @
getVideoFormatInfoDescription :: MonadIO m => VideoFormatInfo -> m (Maybe T.Text)
getVideoFormatInfoDescription :: forall (m :: * -> *).
MonadIO m =>
VideoFormatInfo -> m (Maybe Text)
getVideoFormatInfoDescription VideoFormatInfo
s = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ VideoFormatInfo
-> (Ptr VideoFormatInfo -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoFormatInfo
s ((Ptr VideoFormatInfo -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr VideoFormatInfo -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr VideoFormatInfo
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr VideoFormatInfo
ptr Ptr VideoFormatInfo -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) :: IO CString
    Maybe Text
result <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull CString
val ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
val' -> do
        Text
val'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
val'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
val''
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
result

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

-- | Set the value of the “@description@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #description
-- @
clearVideoFormatInfoDescription :: MonadIO m => VideoFormatInfo -> m ()
clearVideoFormatInfoDescription :: forall (m :: * -> *). MonadIO m => VideoFormatInfo -> m ()
clearVideoFormatInfoDescription VideoFormatInfo
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ VideoFormatInfo -> (Ptr VideoFormatInfo -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoFormatInfo
s ((Ptr VideoFormatInfo -> IO ()) -> IO ())
-> (Ptr VideoFormatInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr VideoFormatInfo
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr VideoFormatInfo
ptr Ptr VideoFormatInfo -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) (CString
forall a. Ptr a
FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING)
data VideoFormatInfoDescriptionFieldInfo
instance AttrInfo VideoFormatInfoDescriptionFieldInfo where
    type AttrBaseTypeConstraint VideoFormatInfoDescriptionFieldInfo = (~) VideoFormatInfo
    type AttrAllowedOps VideoFormatInfoDescriptionFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint VideoFormatInfoDescriptionFieldInfo = (~) CString
    type AttrTransferTypeConstraint VideoFormatInfoDescriptionFieldInfo = (~)CString
    type AttrTransferType VideoFormatInfoDescriptionFieldInfo = CString
    type AttrGetType VideoFormatInfoDescriptionFieldInfo = Maybe T.Text
    type AttrLabel VideoFormatInfoDescriptionFieldInfo = "description"
    type AttrOrigin VideoFormatInfoDescriptionFieldInfo = VideoFormatInfo
    attrGet = getVideoFormatInfoDescription
    attrSet = setVideoFormatInfoDescription
    attrConstruct = undefined
    attrClear = clearVideoFormatInfoDescription
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Structs.VideoFormatInfo.description"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.25/docs/GI-GstVideo-Structs-VideoFormatInfo.html#g:attr:description"
        })

videoFormatInfo_description :: AttrLabelProxy "description"
videoFormatInfo_description = AttrLabelProxy

#endif


-- | Get the value of the “@flags@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' videoFormatInfo #flags
-- @
getVideoFormatInfoFlags :: MonadIO m => VideoFormatInfo -> m [GstVideo.Flags.VideoFormatFlags]
getVideoFormatInfoFlags :: forall (m :: * -> *).
MonadIO m =>
VideoFormatInfo -> m [VideoFormatFlags]
getVideoFormatInfoFlags VideoFormatInfo
s = IO [VideoFormatFlags] -> m [VideoFormatFlags]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [VideoFormatFlags] -> m [VideoFormatFlags])
-> IO [VideoFormatFlags] -> m [VideoFormatFlags]
forall a b. (a -> b) -> a -> b
$ VideoFormatInfo
-> (Ptr VideoFormatInfo -> IO [VideoFormatFlags])
-> IO [VideoFormatFlags]
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoFormatInfo
s ((Ptr VideoFormatInfo -> IO [VideoFormatFlags])
 -> IO [VideoFormatFlags])
-> (Ptr VideoFormatInfo -> IO [VideoFormatFlags])
-> IO [VideoFormatFlags]
forall a b. (a -> b) -> a -> b
$ \Ptr VideoFormatInfo
ptr -> do
    CUInt
val <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr VideoFormatInfo
ptr Ptr VideoFormatInfo -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) :: IO CUInt
    let val' :: [VideoFormatFlags]
val' = CUInt -> [VideoFormatFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
val
    [VideoFormatFlags] -> IO [VideoFormatFlags]
forall (m :: * -> *) a. Monad m => a -> m a
return [VideoFormatFlags]
val'

-- | Set the value of the “@flags@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' videoFormatInfo [ #flags 'Data.GI.Base.Attributes.:=' value ]
-- @
setVideoFormatInfoFlags :: MonadIO m => VideoFormatInfo -> [GstVideo.Flags.VideoFormatFlags] -> m ()
setVideoFormatInfoFlags :: forall (m :: * -> *).
MonadIO m =>
VideoFormatInfo -> [VideoFormatFlags] -> m ()
setVideoFormatInfoFlags VideoFormatInfo
s [VideoFormatFlags]
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ VideoFormatInfo -> (Ptr VideoFormatInfo -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoFormatInfo
s ((Ptr VideoFormatInfo -> IO ()) -> IO ())
-> (Ptr VideoFormatInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr VideoFormatInfo
ptr -> do
    let val' :: CUInt
val' = [VideoFormatFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [VideoFormatFlags]
val
    Ptr CUInt -> CUInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr VideoFormatInfo
ptr Ptr VideoFormatInfo -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) (CUInt
val' :: CUInt)

#if defined(ENABLE_OVERLOADING)
data VideoFormatInfoFlagsFieldInfo
instance AttrInfo VideoFormatInfoFlagsFieldInfo where
    type AttrBaseTypeConstraint VideoFormatInfoFlagsFieldInfo = (~) VideoFormatInfo
    type AttrAllowedOps VideoFormatInfoFlagsFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoFormatInfoFlagsFieldInfo = (~) [GstVideo.Flags.VideoFormatFlags]
    type AttrTransferTypeConstraint VideoFormatInfoFlagsFieldInfo = (~)[GstVideo.Flags.VideoFormatFlags]
    type AttrTransferType VideoFormatInfoFlagsFieldInfo = [GstVideo.Flags.VideoFormatFlags]
    type AttrGetType VideoFormatInfoFlagsFieldInfo = [GstVideo.Flags.VideoFormatFlags]
    type AttrLabel VideoFormatInfoFlagsFieldInfo = "flags"
    type AttrOrigin VideoFormatInfoFlagsFieldInfo = VideoFormatInfo
    attrGet = getVideoFormatInfoFlags
    attrSet = setVideoFormatInfoFlags
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Structs.VideoFormatInfo.flags"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.25/docs/GI-GstVideo-Structs-VideoFormatInfo.html#g:attr:flags"
        })

videoFormatInfo_flags :: AttrLabelProxy "flags"
videoFormatInfo_flags = AttrLabelProxy

#endif


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

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

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

videoFormatInfo_bits :: AttrLabelProxy "bits"
videoFormatInfo_bits = AttrLabelProxy

#endif


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

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

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

videoFormatInfo_nComponents :: AttrLabelProxy "nComponents"
videoFormatInfo_nComponents = AttrLabelProxy

#endif


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

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

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

videoFormatInfo_nPlanes :: AttrLabelProxy "nPlanes"
videoFormatInfo_nPlanes = AttrLabelProxy

#endif


-- XXX Skipped attribute for "VideoFormatInfo:plane"
-- Not implemented: Don't know how to unpack C array of type TCArray False 4 (-1) (TBasicType TUInt)
-- XXX Skipped attribute for "VideoFormatInfo:poffset"
-- Not implemented: Don't know how to unpack C array of type TCArray False 4 (-1) (TBasicType TUInt)
-- XXX Skipped attribute for "VideoFormatInfo:w_sub"
-- Not implemented: Don't know how to unpack C array of type TCArray False 4 (-1) (TBasicType TUInt)
-- XXX Skipped attribute for "VideoFormatInfo:h_sub"
-- Not implemented: Don't know how to unpack C array of type TCArray False 4 (-1) (TBasicType TUInt)
-- | Get the value of the “@unpack_format@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' videoFormatInfo #unpackFormat
-- @
getVideoFormatInfoUnpackFormat :: MonadIO m => VideoFormatInfo -> m GstVideo.Enums.VideoFormat
getVideoFormatInfoUnpackFormat :: forall (m :: * -> *). MonadIO m => VideoFormatInfo -> m VideoFormat
getVideoFormatInfoUnpackFormat VideoFormatInfo
s = IO VideoFormat -> m VideoFormat
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO VideoFormat -> m VideoFormat)
-> IO VideoFormat -> m VideoFormat
forall a b. (a -> b) -> a -> b
$ VideoFormatInfo
-> (Ptr VideoFormatInfo -> IO VideoFormat) -> IO VideoFormat
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoFormatInfo
s ((Ptr VideoFormatInfo -> IO VideoFormat) -> IO VideoFormat)
-> (Ptr VideoFormatInfo -> IO VideoFormat) -> IO VideoFormat
forall a b. (a -> b) -> a -> b
$ \Ptr VideoFormatInfo
ptr -> do
    CUInt
val <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr VideoFormatInfo
ptr Ptr VideoFormatInfo -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
152) :: IO CUInt
    let val' :: VideoFormat
val' = (Int -> VideoFormat
forall a. Enum a => Int -> a
toEnum (Int -> VideoFormat) -> (CUInt -> Int) -> CUInt -> VideoFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
val
    VideoFormat -> IO VideoFormat
forall (m :: * -> *) a. Monad m => a -> m a
return VideoFormat
val'

-- | Set the value of the “@unpack_format@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' videoFormatInfo [ #unpackFormat 'Data.GI.Base.Attributes.:=' value ]
-- @
setVideoFormatInfoUnpackFormat :: MonadIO m => VideoFormatInfo -> GstVideo.Enums.VideoFormat -> m ()
setVideoFormatInfoUnpackFormat :: forall (m :: * -> *).
MonadIO m =>
VideoFormatInfo -> VideoFormat -> m ()
setVideoFormatInfoUnpackFormat VideoFormatInfo
s VideoFormat
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ VideoFormatInfo -> (Ptr VideoFormatInfo -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoFormatInfo
s ((Ptr VideoFormatInfo -> IO ()) -> IO ())
-> (Ptr VideoFormatInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr VideoFormatInfo
ptr -> do
    let val' :: CUInt
val' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (VideoFormat -> Int) -> VideoFormat -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VideoFormat -> Int
forall a. Enum a => a -> Int
fromEnum) VideoFormat
val
    Ptr CUInt -> CUInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr VideoFormatInfo
ptr Ptr VideoFormatInfo -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
152) (CUInt
val' :: CUInt)

#if defined(ENABLE_OVERLOADING)
data VideoFormatInfoUnpackFormatFieldInfo
instance AttrInfo VideoFormatInfoUnpackFormatFieldInfo where
    type AttrBaseTypeConstraint VideoFormatInfoUnpackFormatFieldInfo = (~) VideoFormatInfo
    type AttrAllowedOps VideoFormatInfoUnpackFormatFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoFormatInfoUnpackFormatFieldInfo = (~) GstVideo.Enums.VideoFormat
    type AttrTransferTypeConstraint VideoFormatInfoUnpackFormatFieldInfo = (~)GstVideo.Enums.VideoFormat
    type AttrTransferType VideoFormatInfoUnpackFormatFieldInfo = GstVideo.Enums.VideoFormat
    type AttrGetType VideoFormatInfoUnpackFormatFieldInfo = GstVideo.Enums.VideoFormat
    type AttrLabel VideoFormatInfoUnpackFormatFieldInfo = "unpack_format"
    type AttrOrigin VideoFormatInfoUnpackFormatFieldInfo = VideoFormatInfo
    attrGet = getVideoFormatInfoUnpackFormat
    attrSet = setVideoFormatInfoUnpackFormat
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Structs.VideoFormatInfo.unpackFormat"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.25/docs/GI-GstVideo-Structs-VideoFormatInfo.html#g:attr:unpackFormat"
        })

videoFormatInfo_unpackFormat :: AttrLabelProxy "unpackFormat"
videoFormatInfo_unpackFormat = AttrLabelProxy

#endif


-- | Get the value of the “@unpack_func@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' videoFormatInfo #unpackFunc
-- @
getVideoFormatInfoUnpackFunc :: MonadIO m => VideoFormatInfo -> m (Maybe GstVideo.Callbacks.VideoFormatUnpack)
getVideoFormatInfoUnpackFunc :: forall (m :: * -> *).
MonadIO m =>
VideoFormatInfo -> m (Maybe VideoFormatUnpack)
getVideoFormatInfoUnpackFunc VideoFormatInfo
s = IO (Maybe VideoFormatUnpack) -> m (Maybe VideoFormatUnpack)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe VideoFormatUnpack) -> m (Maybe VideoFormatUnpack))
-> IO (Maybe VideoFormatUnpack) -> m (Maybe VideoFormatUnpack)
forall a b. (a -> b) -> a -> b
$ VideoFormatInfo
-> (Ptr VideoFormatInfo -> IO (Maybe VideoFormatUnpack))
-> IO (Maybe VideoFormatUnpack)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoFormatInfo
s ((Ptr VideoFormatInfo -> IO (Maybe VideoFormatUnpack))
 -> IO (Maybe VideoFormatUnpack))
-> (Ptr VideoFormatInfo -> IO (Maybe VideoFormatUnpack))
-> IO (Maybe VideoFormatUnpack)
forall a b. (a -> b) -> a -> b
$ \Ptr VideoFormatInfo
ptr -> do
    FunPtr C_VideoFormatUnpack
val <- Ptr (FunPtr C_VideoFormatUnpack) -> IO (FunPtr C_VideoFormatUnpack)
forall a. Storable a => Ptr a -> IO a
peek (Ptr VideoFormatInfo
ptr Ptr VideoFormatInfo -> Int -> Ptr (FunPtr C_VideoFormatUnpack)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
160) :: IO (FunPtr GstVideo.Callbacks.C_VideoFormatUnpack)
    Maybe VideoFormatUnpack
result <- FunPtr C_VideoFormatUnpack
-> (FunPtr C_VideoFormatUnpack -> IO VideoFormatUnpack)
-> IO (Maybe VideoFormatUnpack)
forall a b. FunPtr a -> (FunPtr a -> IO b) -> IO (Maybe b)
SP.convertFunPtrIfNonNull FunPtr C_VideoFormatUnpack
val ((FunPtr C_VideoFormatUnpack -> IO VideoFormatUnpack)
 -> IO (Maybe VideoFormatUnpack))
-> (FunPtr C_VideoFormatUnpack -> IO VideoFormatUnpack)
-> IO (Maybe VideoFormatUnpack)
forall a b. (a -> b) -> a -> b
$ \FunPtr C_VideoFormatUnpack
val' -> do
        let val'' :: VideoFormatUnpack
val'' = FunPtr C_VideoFormatUnpack -> VideoFormatUnpack
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FunPtr C_VideoFormatUnpack
-> VideoFormatInfo
-> [VideoPackFlags]
-> Ptr ()
-> Ptr ()
-> Int32
-> Int32
-> Int32
-> Int32
-> m ()
GstVideo.Callbacks.dynamic_VideoFormatUnpack FunPtr C_VideoFormatUnpack
val'
        VideoFormatUnpack -> IO VideoFormatUnpack
forall (m :: * -> *) a. Monad m => a -> m a
return VideoFormatUnpack
val''
    Maybe VideoFormatUnpack -> IO (Maybe VideoFormatUnpack)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe VideoFormatUnpack
result

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

-- | Set the value of the “@unpack_func@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #unpackFunc
-- @
clearVideoFormatInfoUnpackFunc :: MonadIO m => VideoFormatInfo -> m ()
clearVideoFormatInfoUnpackFunc :: forall (m :: * -> *). MonadIO m => VideoFormatInfo -> m ()
clearVideoFormatInfoUnpackFunc VideoFormatInfo
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ VideoFormatInfo -> (Ptr VideoFormatInfo -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoFormatInfo
s ((Ptr VideoFormatInfo -> IO ()) -> IO ())
-> (Ptr VideoFormatInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr VideoFormatInfo
ptr -> do
    Ptr (FunPtr C_VideoFormatUnpack)
-> FunPtr C_VideoFormatUnpack -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr VideoFormatInfo
ptr Ptr VideoFormatInfo -> Int -> Ptr (FunPtr C_VideoFormatUnpack)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
160) (FunPtr C_VideoFormatUnpack
forall a. FunPtr a
FP.nullFunPtr :: FunPtr GstVideo.Callbacks.C_VideoFormatUnpack)

#if defined(ENABLE_OVERLOADING)
data VideoFormatInfoUnpackFuncFieldInfo
instance AttrInfo VideoFormatInfoUnpackFuncFieldInfo where
    type AttrBaseTypeConstraint VideoFormatInfoUnpackFuncFieldInfo = (~) VideoFormatInfo
    type AttrAllowedOps VideoFormatInfoUnpackFuncFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint VideoFormatInfoUnpackFuncFieldInfo = (~) (FunPtr GstVideo.Callbacks.C_VideoFormatUnpack)
    type AttrTransferTypeConstraint VideoFormatInfoUnpackFuncFieldInfo = (~)GstVideo.Callbacks.VideoFormatUnpack
    type AttrTransferType VideoFormatInfoUnpackFuncFieldInfo = (FunPtr GstVideo.Callbacks.C_VideoFormatUnpack)
    type AttrGetType VideoFormatInfoUnpackFuncFieldInfo = Maybe GstVideo.Callbacks.VideoFormatUnpack
    type AttrLabel VideoFormatInfoUnpackFuncFieldInfo = "unpack_func"
    type AttrOrigin VideoFormatInfoUnpackFuncFieldInfo = VideoFormatInfo
    attrGet = getVideoFormatInfoUnpackFunc
    attrSet = setVideoFormatInfoUnpackFunc
    attrConstruct = undefined
    attrClear = clearVideoFormatInfoUnpackFunc
    attrTransfer _ v = do
        GstVideo.Callbacks.mk_VideoFormatUnpack (GstVideo.Callbacks.wrap_VideoFormatUnpack Nothing v)
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Structs.VideoFormatInfo.unpackFunc"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.25/docs/GI-GstVideo-Structs-VideoFormatInfo.html#g:attr:unpackFunc"
        })

videoFormatInfo_unpackFunc :: AttrLabelProxy "unpackFunc"
videoFormatInfo_unpackFunc = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data VideoFormatInfoPackLinesFieldInfo
instance AttrInfo VideoFormatInfoPackLinesFieldInfo where
    type AttrBaseTypeConstraint VideoFormatInfoPackLinesFieldInfo = (~) VideoFormatInfo
    type AttrAllowedOps VideoFormatInfoPackLinesFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoFormatInfoPackLinesFieldInfo = (~) Int32
    type AttrTransferTypeConstraint VideoFormatInfoPackLinesFieldInfo = (~)Int32
    type AttrTransferType VideoFormatInfoPackLinesFieldInfo = Int32
    type AttrGetType VideoFormatInfoPackLinesFieldInfo = Int32
    type AttrLabel VideoFormatInfoPackLinesFieldInfo = "pack_lines"
    type AttrOrigin VideoFormatInfoPackLinesFieldInfo = VideoFormatInfo
    attrGet = getVideoFormatInfoPackLines
    attrSet = setVideoFormatInfoPackLines
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Structs.VideoFormatInfo.packLines"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.25/docs/GI-GstVideo-Structs-VideoFormatInfo.html#g:attr:packLines"
        })

videoFormatInfo_packLines :: AttrLabelProxy "packLines"
videoFormatInfo_packLines = AttrLabelProxy

#endif


-- | Get the value of the “@pack_func@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' videoFormatInfo #packFunc
-- @
getVideoFormatInfoPackFunc :: MonadIO m => VideoFormatInfo -> m (Maybe GstVideo.Callbacks.VideoFormatPack)
getVideoFormatInfoPackFunc :: forall (m :: * -> *).
MonadIO m =>
VideoFormatInfo -> m (Maybe VideoFormatPack)
getVideoFormatInfoPackFunc VideoFormatInfo
s = IO (Maybe VideoFormatPack) -> m (Maybe VideoFormatPack)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe VideoFormatPack) -> m (Maybe VideoFormatPack))
-> IO (Maybe VideoFormatPack) -> m (Maybe VideoFormatPack)
forall a b. (a -> b) -> a -> b
$ VideoFormatInfo
-> (Ptr VideoFormatInfo -> IO (Maybe VideoFormatPack))
-> IO (Maybe VideoFormatPack)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoFormatInfo
s ((Ptr VideoFormatInfo -> IO (Maybe VideoFormatPack))
 -> IO (Maybe VideoFormatPack))
-> (Ptr VideoFormatInfo -> IO (Maybe VideoFormatPack))
-> IO (Maybe VideoFormatPack)
forall a b. (a -> b) -> a -> b
$ \Ptr VideoFormatInfo
ptr -> do
    FunPtr C_VideoFormatPack
val <- Ptr (FunPtr C_VideoFormatPack) -> IO (FunPtr C_VideoFormatPack)
forall a. Storable a => Ptr a -> IO a
peek (Ptr VideoFormatInfo
ptr Ptr VideoFormatInfo -> Int -> Ptr (FunPtr C_VideoFormatPack)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
176) :: IO (FunPtr GstVideo.Callbacks.C_VideoFormatPack)
    Maybe VideoFormatPack
result <- FunPtr C_VideoFormatPack
-> (FunPtr C_VideoFormatPack -> IO VideoFormatPack)
-> IO (Maybe VideoFormatPack)
forall a b. FunPtr a -> (FunPtr a -> IO b) -> IO (Maybe b)
SP.convertFunPtrIfNonNull FunPtr C_VideoFormatPack
val ((FunPtr C_VideoFormatPack -> IO VideoFormatPack)
 -> IO (Maybe VideoFormatPack))
-> (FunPtr C_VideoFormatPack -> IO VideoFormatPack)
-> IO (Maybe VideoFormatPack)
forall a b. (a -> b) -> a -> b
$ \FunPtr C_VideoFormatPack
val' -> do
        let val'' :: VideoFormatPack
val'' = FunPtr C_VideoFormatPack -> VideoFormatPack
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FunPtr C_VideoFormatPack
-> VideoFormatInfo
-> [VideoPackFlags]
-> Ptr ()
-> Int32
-> Ptr ()
-> Int32
-> [VideoChromaSite]
-> Int32
-> Int32
-> m ()
GstVideo.Callbacks.dynamic_VideoFormatPack FunPtr C_VideoFormatPack
val'
        VideoFormatPack -> IO VideoFormatPack
forall (m :: * -> *) a. Monad m => a -> m a
return VideoFormatPack
val''
    Maybe VideoFormatPack -> IO (Maybe VideoFormatPack)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe VideoFormatPack
result

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

-- | Set the value of the “@pack_func@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #packFunc
-- @
clearVideoFormatInfoPackFunc :: MonadIO m => VideoFormatInfo -> m ()
clearVideoFormatInfoPackFunc :: forall (m :: * -> *). MonadIO m => VideoFormatInfo -> m ()
clearVideoFormatInfoPackFunc VideoFormatInfo
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ VideoFormatInfo -> (Ptr VideoFormatInfo -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoFormatInfo
s ((Ptr VideoFormatInfo -> IO ()) -> IO ())
-> (Ptr VideoFormatInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr VideoFormatInfo
ptr -> do
    Ptr (FunPtr C_VideoFormatPack) -> FunPtr C_VideoFormatPack -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr VideoFormatInfo
ptr Ptr VideoFormatInfo -> Int -> Ptr (FunPtr C_VideoFormatPack)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
176) (FunPtr C_VideoFormatPack
forall a. FunPtr a
FP.nullFunPtr :: FunPtr GstVideo.Callbacks.C_VideoFormatPack)

#if defined(ENABLE_OVERLOADING)
data VideoFormatInfoPackFuncFieldInfo
instance AttrInfo VideoFormatInfoPackFuncFieldInfo where
    type AttrBaseTypeConstraint VideoFormatInfoPackFuncFieldInfo = (~) VideoFormatInfo
    type AttrAllowedOps VideoFormatInfoPackFuncFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint VideoFormatInfoPackFuncFieldInfo = (~) (FunPtr GstVideo.Callbacks.C_VideoFormatPack)
    type AttrTransferTypeConstraint VideoFormatInfoPackFuncFieldInfo = (~)GstVideo.Callbacks.VideoFormatPack
    type AttrTransferType VideoFormatInfoPackFuncFieldInfo = (FunPtr GstVideo.Callbacks.C_VideoFormatPack)
    type AttrGetType VideoFormatInfoPackFuncFieldInfo = Maybe GstVideo.Callbacks.VideoFormatPack
    type AttrLabel VideoFormatInfoPackFuncFieldInfo = "pack_func"
    type AttrOrigin VideoFormatInfoPackFuncFieldInfo = VideoFormatInfo
    attrGet = getVideoFormatInfoPackFunc
    attrSet = setVideoFormatInfoPackFunc
    attrConstruct = undefined
    attrClear = clearVideoFormatInfoPackFunc
    attrTransfer _ v = do
        GstVideo.Callbacks.mk_VideoFormatPack (GstVideo.Callbacks.wrap_VideoFormatPack Nothing v)
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Structs.VideoFormatInfo.packFunc"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.25/docs/GI-GstVideo-Structs-VideoFormatInfo.html#g:attr:packFunc"
        })

videoFormatInfo_packFunc :: AttrLabelProxy "packFunc"
videoFormatInfo_packFunc = AttrLabelProxy

#endif


-- | Get the value of the “@tile_mode@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' videoFormatInfo #tileMode
-- @
getVideoFormatInfoTileMode :: MonadIO m => VideoFormatInfo -> m GstVideo.Enums.VideoTileMode
getVideoFormatInfoTileMode :: forall (m :: * -> *).
MonadIO m =>
VideoFormatInfo -> m VideoTileMode
getVideoFormatInfoTileMode VideoFormatInfo
s = IO VideoTileMode -> m VideoTileMode
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO VideoTileMode -> m VideoTileMode)
-> IO VideoTileMode -> m VideoTileMode
forall a b. (a -> b) -> a -> b
$ VideoFormatInfo
-> (Ptr VideoFormatInfo -> IO VideoTileMode) -> IO VideoTileMode
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoFormatInfo
s ((Ptr VideoFormatInfo -> IO VideoTileMode) -> IO VideoTileMode)
-> (Ptr VideoFormatInfo -> IO VideoTileMode) -> IO VideoTileMode
forall a b. (a -> b) -> a -> b
$ \Ptr VideoFormatInfo
ptr -> do
    CUInt
val <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr VideoFormatInfo
ptr Ptr VideoFormatInfo -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
184) :: IO CUInt
    let val' :: VideoTileMode
val' = (Int -> VideoTileMode
forall a. Enum a => Int -> a
toEnum (Int -> VideoTileMode) -> (CUInt -> Int) -> CUInt -> VideoTileMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
val
    VideoTileMode -> IO VideoTileMode
forall (m :: * -> *) a. Monad m => a -> m a
return VideoTileMode
val'

-- | Set the value of the “@tile_mode@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' videoFormatInfo [ #tileMode 'Data.GI.Base.Attributes.:=' value ]
-- @
setVideoFormatInfoTileMode :: MonadIO m => VideoFormatInfo -> GstVideo.Enums.VideoTileMode -> m ()
setVideoFormatInfoTileMode :: forall (m :: * -> *).
MonadIO m =>
VideoFormatInfo -> VideoTileMode -> m ()
setVideoFormatInfoTileMode VideoFormatInfo
s VideoTileMode
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ VideoFormatInfo -> (Ptr VideoFormatInfo -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoFormatInfo
s ((Ptr VideoFormatInfo -> IO ()) -> IO ())
-> (Ptr VideoFormatInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr VideoFormatInfo
ptr -> do
    let val' :: CUInt
val' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (VideoTileMode -> Int) -> VideoTileMode -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VideoTileMode -> Int
forall a. Enum a => a -> Int
fromEnum) VideoTileMode
val
    Ptr CUInt -> CUInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr VideoFormatInfo
ptr Ptr VideoFormatInfo -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
184) (CUInt
val' :: CUInt)

#if defined(ENABLE_OVERLOADING)
data VideoFormatInfoTileModeFieldInfo
instance AttrInfo VideoFormatInfoTileModeFieldInfo where
    type AttrBaseTypeConstraint VideoFormatInfoTileModeFieldInfo = (~) VideoFormatInfo
    type AttrAllowedOps VideoFormatInfoTileModeFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoFormatInfoTileModeFieldInfo = (~) GstVideo.Enums.VideoTileMode
    type AttrTransferTypeConstraint VideoFormatInfoTileModeFieldInfo = (~)GstVideo.Enums.VideoTileMode
    type AttrTransferType VideoFormatInfoTileModeFieldInfo = GstVideo.Enums.VideoTileMode
    type AttrGetType VideoFormatInfoTileModeFieldInfo = GstVideo.Enums.VideoTileMode
    type AttrLabel VideoFormatInfoTileModeFieldInfo = "tile_mode"
    type AttrOrigin VideoFormatInfoTileModeFieldInfo = VideoFormatInfo
    attrGet = getVideoFormatInfoTileMode
    attrSet = setVideoFormatInfoTileMode
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Structs.VideoFormatInfo.tileMode"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.25/docs/GI-GstVideo-Structs-VideoFormatInfo.html#g:attr:tileMode"
        })

videoFormatInfo_tileMode :: AttrLabelProxy "tileMode"
videoFormatInfo_tileMode = AttrLabelProxy

#endif


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

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

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

videoFormatInfo_tileWs :: AttrLabelProxy "tileWs"
videoFormatInfo_tileWs = AttrLabelProxy

#endif


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

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

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

videoFormatInfo_tileHs :: AttrLabelProxy "tileHs"
videoFormatInfo_tileHs = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList VideoFormatInfo
type instance O.AttributeList VideoFormatInfo = VideoFormatInfoAttributeList
type VideoFormatInfoAttributeList = ('[ '("format", VideoFormatInfoFormatFieldInfo), '("name", VideoFormatInfoNameFieldInfo), '("description", VideoFormatInfoDescriptionFieldInfo), '("flags", VideoFormatInfoFlagsFieldInfo), '("bits", VideoFormatInfoBitsFieldInfo), '("nComponents", VideoFormatInfoNComponentsFieldInfo), '("nPlanes", VideoFormatInfoNPlanesFieldInfo), '("unpackFormat", VideoFormatInfoUnpackFormatFieldInfo), '("unpackFunc", VideoFormatInfoUnpackFuncFieldInfo), '("packLines", VideoFormatInfoPackLinesFieldInfo), '("packFunc", VideoFormatInfoPackFuncFieldInfo), '("tileMode", VideoFormatInfoTileModeFieldInfo), '("tileWs", VideoFormatInfoTileWsFieldInfo), '("tileHs", VideoFormatInfoTileHsFieldInfo)] :: [(Symbol, *)])
#endif

-- method VideoFormatInfo::component
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoFormatInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GstVideoFormatInfo"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "plane"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a plane number" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "components"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "array used to store component numbers"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_format_info_component" gst_video_format_info_component :: 
    Ptr VideoFormatInfo ->                  -- info : TInterface (Name {namespace = "GstVideo", name = "VideoFormatInfo"})
    Word32 ->                               -- plane : TBasicType TUInt
    Ptr Int32 ->                            -- components : TBasicType TInt
    IO ()

-- | Fill /@components@/ with the number of all the components packed in plane /@p@/
-- for the format /@info@/. A value of -1 in /@components@/ indicates that no more
-- components are packed in the plane.
-- 
-- /Since: 1.18/
videoFormatInfoComponent ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoFormatInfo
    -- ^ /@info@/: t'GI.GstVideo.Structs.VideoFormatInfo.VideoFormatInfo'
    -> Word32
    -- ^ /@plane@/: a plane number
    -> m (Int32)
videoFormatInfoComponent :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
VideoFormatInfo -> Word32 -> m Int32
videoFormatInfoComponent VideoFormatInfo
info Word32
plane = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoFormatInfo
info' <- VideoFormatInfo -> IO (Ptr VideoFormatInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoFormatInfo
info
    Ptr Int32
components <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr VideoFormatInfo -> Word32 -> Ptr Int32 -> IO ()
gst_video_format_info_component Ptr VideoFormatInfo
info' Word32
plane Ptr Int32
components
    Int32
components' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
components
    VideoFormatInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoFormatInfo
info
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
components
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
components'

#if defined(ENABLE_OVERLOADING)
data VideoFormatInfoComponentMethodInfo
instance (signature ~ (Word32 -> m (Int32)), MonadIO m) => O.OverloadedMethod VideoFormatInfoComponentMethodInfo VideoFormatInfo signature where
    overloadedMethod = videoFormatInfoComponent

instance O.OverloadedMethodInfo VideoFormatInfoComponentMethodInfo VideoFormatInfo where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Structs.VideoFormatInfo.videoFormatInfoComponent",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.25/docs/GI-GstVideo-Structs-VideoFormatInfo.html#v:videoFormatInfoComponent"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveVideoFormatInfoMethod (t :: Symbol) (o :: *) :: * where
    ResolveVideoFormatInfoMethod "component" o = VideoFormatInfoComponentMethodInfo
    ResolveVideoFormatInfoMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif